use
5.008;
our
$VERSION
=
'0.04'
;
sub
report {
my
$self
=
shift
;
$self
->{run_as_api} = 1;
return
$self
->_do_report(
@_
);
}
sub
_do_report {
my
$self
=
shift
;
$self
->_fatal(
"Required 'server' setting is empty or missing"
)
unless
$self
->server;
$self
->_fatal(
"Required 'project_id' setting is empty or missing"
)
unless
$self
->project_id;
$self
->_fatal(
"Required 'username' setting is empty or missing"
)
unless
$self
->username;
$self
->_fatal(
"Required 'password' setting is empty or missing"
)
unless
$self
->password;
$self
->_fatal(
"You must provide at least one report to upload"
)
unless
@_
;
return
$self
->_upload_reports(
@_
);
}
sub
_upload_reports {
my
(
$self
,
@reports
) =
@_
;
my
$server
=
$self
->server;
my
$reports_url
;
unless
$server
=~ m/^http/;
my
$ua
= LWP::UserAgent->new;
my
$url
=
$server
.
'/app/developer_projects/process_add_report/'
.
$self
->project_id;
REPORT_FILE:
foreach
my
$report_file
(
@reports
) {
$self
->_fatal(
"Could not read report file '$report_file'"
)
unless
-r
$report_file
;
if
(
$self
->dry_run) {
$self
->_log(
"Dry run: would POST to $url: $report_file"
);
next
REPORT_FILE;
}
my
$response
=
$ua
->post(
$url
,
'Content-Type'
=>
'form-data'
,
'Content'
=> [
username
=>
$self
->username,
password
=>
$self
->password,
tags
=>
''
,
report_file
=> [
$report_file
],
],
);
if
(
$response
->code == 302) {
if
(!
$reports_url
) {
$reports_url
=
$response
->header(
'Location'
);
$reports_url
=
"$server$reports_url"
unless
$reports_url
=~ m/^http/;
}
$self
->_log(
"Report '$report_file' sent successfully"
);
if
(
$self
->
delete
) {
if
(!
unlink
(
$report_file
)) {
$self
->_log(
"WARNING: could not delete file $report_file: $!"
);
}
}
}
else
{
$self
->_fatal(
"Could not upload report '$report_file'"
,
"HTTP Code: "
.
$response
->code,
$response
->message,
);
}
}
$self
->_log(
"See all reports at $reports_url"
)
if
$reports_url
;
return
$reports_url
;
}
sub
_load_configs {
my
(
$self
) =
@_
;
my
$filename
=
'.smolder.conf'
;
my
@files_to_check
= (
$filename
);
unshift
@files_to_check
,
"$ENV{HOME}/$filename"
if
$ENV
{HOME};
push
@files_to_check
,
$ENV
{APP_SMOLDER_REPORT_CONF}
if
$ENV
{APP_SMOLDER_REPORT_CONF};
foreach
my
$file
(
@files_to_check
) {
$self
->_merge_cfg_file(
$file
);
}
return
;
}
sub
_merge_cfg_file {
my
(
$self
,
$file
) =
@_
;
my
$cfg
=
$self
->_read_cfg_file(
$file
);
return
unless
$cfg
;
$self
->_merge_cfg_hash(
$cfg
);
if
(
%$cfg
) {
my
@bad_keys
=
sort
keys
%$cfg
;
$self
->_fatal(
"Invalid configuration keys in $file:"
,
@bad_keys
);
}
return
;
}
sub
_read_cfg_file {
my
(
$self
,
$file
) =
@_
;
my
%cfg
;
local
$_
;
open
(
my
$fh
,
'<'
,
$file
) ||
return
;
while
(<
$fh
>) {
s/^\s+|\s+$//g;
next
if
/^(
if
(/^(\S+)\s*=\s*(["'])(.*)\2$/) {
$cfg
{$1} = $3;
}
elsif
(/^(\S+)\s*=\s*(.+)$/) {
$cfg
{$1} = $2;
}
else
{
$self
->_fatal(
"Could not parse line $. of $file: $_"
);
}
}
close
(
$fh
);
return
\
%cfg
;
}
sub
_merge_cfg_hash {
my
(
$self
,
$cfg
) =
@_
;
my
@valid_settings
=
qw{
server project_id
username password
delete
}
;
foreach
my
$cfg_key
(
@valid_settings
) {
next
unless
exists
$cfg
->{
$cfg_key
};
$self
->{
$cfg_key
} =
delete
$cfg
->{
$cfg_key
};
}
return
;
}
sub
process_args {
my
(
$self
) =
@_
;
my
(
$username
,
$password
,
$server
,
$project_id
,
$dry_run
,
$delete
,
$quiet
);
my
$ok
= GetOptions(
"username=s"
=> \
$username
,
"password=s"
=> \
$password
,
"server=s"
=> \
$server
,
"project-id=i"
=> \
$project_id
,
"dry-run|n"
=> \
$dry_run
,
"quiet"
=> \
$quiet
,
"delete"
=> \
$delete
,
);
exit
(2)
unless
$ok
;
$self
->_load_configs;
$self
->{username} =
$username
if
defined
$username
;
$self
->{password} =
$password
if
defined
$password
;
$self
->{server} =
$server
if
defined
$server
;
$self
->{project_id} =
$project_id
if
defined
$project_id
;
$self
->{dry_run} =
$dry_run
if
defined
$dry_run
;
$self
->{quiet} =
$quiet
if
defined
$quiet
;
$self
->{
delete
} =
$delete
if
defined
$delete
;
return
;
}
sub
run {
my
$self
=
shift
;
$self
->{run_as_api} = 0;
return
$self
->_do_report(
@_
);
}
sub
_fatal {
my
(
$self
,
$mesg
,
@more
) =
@_
;
$mesg
=
"FATAL: $mesg\n"
;
foreach
my
$line
(
@more
) {
$mesg
.=
" $line\n"
;
}
croak(
$mesg
)
if
$self
->run_as_api;
print
$mesg
;
exit
(1);
}
sub
_log {
my
(
$self
,
$mesg
) =
@_
;
return
if
$self
->run_as_api;
return
if
$self
->quiet;
print
"$mesg\n"
;
return
;
}
sub
new {
my
$class
=
shift
;
my
$self
=
bless
{},
$class
;
my
%args
;
if
(
ref
(
$_
[0])) {
%args
= %{
$_
[0]} }
else
{
%args
=
@_
}
$self
->_load_configs
if
delete
$args
{load_config};
while
(
my
(
$k
,
$v
) =
each
%args
) {
$self
->{
$k
} =
$v
;
}
return
$self
;
}
sub
dry_run {
return
$_
[0]{dry_run} }
sub
quiet {
return
$_
[0]{quiet} }
sub
username {
return
$_
[0]{username} }
sub
password {
return
$_
[0]{password} }
sub
delete
{
return
$_
[0]{
delete
} }
sub
project_id {
return
$_
[0]{project_id} }
sub
server {
return
$_
[0]{server} }
sub
run_as_api {
return
$_
[0]{run_as_api} }