our
$VERSION
= 0.05;
has
'key'
;
has
'error'
;
has
'delay'
=>
$ENV
{GCIS_API_DELAY};
has
ua
=>
sub
{
my
$c
=
shift
;
state
$ua
;
return
$ua
if
$ua
;
$ua
= Mojo::UserAgent->new();
$ua
->on(
start
=>
sub
{
my
(
$ua
,
$tx
) =
@_
;
$tx
->req->headers->header(
$c
->auth_hdr)
if
$c
->auth_hdr;
$tx
->req->headers->header(
Accept
=>
$c
->
accept
);
}
);
$ua
->max_redirects(5);
$ua
;
};
has
logger
=>
sub
{ state
$log
||= Mojo::Log->new(); };
has
json
=>
sub
{ state
$json
||= JSON::XS->new(); };
has
accept
=>
"application/json"
;
has
'tx'
;
sub
auth_hdr { (
$a
=
shift
->key) ? (
"Authorization"
=>
"Basic $a"
) : () }
sub
get {
my
$s
=
shift
;
my
$path
=
shift
;
if
(
defined
(
$s
->delay)) {
sleep
$s
->delay;
}
my
$tx
=
$s
->ua->get(
$s
->url.
"$path"
);
$s
->tx(
$tx
);
my
$res
=
$tx
->success;
unless
(
$res
) {
if
(
$tx
->res->code &&
$tx
->res->code == 404) {
$s
->error(
"not found : $path"
);
return
;
}
$s
->error(
$tx
->error);
$s
->logger->error(
$tx
->error);
return
;
};
my
$json
=
$res
->json or
do
{
$s
->logger->debug(
"no json from $path : "
.
$res
->to_string);
$s
->error(
"No JSON returned from $path : "
.
$res
->to_string);
return
;
};
return
wantarray
&&
ref
(
$json
) eq
'ARRAY'
?
@$json
:
$json
;
}
sub
post {
my
$s
=
shift
;
my
$path
=
shift
;
my
$data
=
shift
;
my
$tx
=
$s
->ua->post(
$s
->url.
"$path"
=>
json
=>
$data
);
$s
->tx(
$tx
);
my
$res
=
$tx
->success or
do
{
$s
->logger->error(
"$path : "
.
$tx
->error.
$tx
->res->body);
return
;
};
return
unless
$res
;
my
$json
=
$res
->json or
return
$res
->body;
return
$res
->json;
}
sub
delete
{
my
$s
=
shift
;
my
$path
=
shift
;
my
$tx
=
$s
->ua->
delete
(
$s
->url.
"$path"
);
$s
->tx(
$tx
);
my
$res
=
$tx
->success;
unless
(
$res
) {
if
(
$tx
->res->code &&
$tx
->res->code == 404) {
$s
->error(
"not found : $path"
);
return
;
}
$s
->error(
$tx
->error);
$s
->logger->error(
$tx
->error);
return
;
};
return
$res
->body;
}
sub
put_file {
my
$s
=
shift
;
my
$path
=
shift
;
my
$file
=
shift
;
my
$data
= file(
$file
)->slurp;
my
$tx
=
$s
->ua->put(
$s
->url.
"$path"
=>
$data
);
$s
->tx(
$tx
);
my
$res
=
$tx
->success or
do
{
$s
->logger->error(
"$path : "
.
$tx
->error.
$tx
->res->body);
return
;
};
return
unless
$res
;
my
$json
=
$res
->json or
return
$res
->body;
return
$res
->json;
}
sub
post_quiet {
my
$s
=
shift
;
my
$path
=
shift
;
my
$data
=
shift
;
my
$tx
=
$s
->ua->post(
$s
->url.
"$path"
=>
json
=>
$data
);
$s
->tx(
$tx
);
my
$res
=
$tx
->success or
do
{
$s
->logger->error(
"$path : "
.
$tx
->error.
$tx
->res->body)
unless
$tx
->res->code == 404;
return
;
};
return
unless
$res
;
my
$json
=
$res
->json or
return
$res
->body;
return
$res
->json;
}
sub
find_credentials {
my
$s
=
shift
;
my
$home
=
$ENV
{HOME};
die
"need url to find credentials"
unless
$s
->url;
my
$conf_file
=
"$home/etc/Gcis.conf"
;
-e
$conf_file
or
die
"Missing $conf_file"
;
my
$conf
= LoadFile(
$conf_file
);
my
@found
=
grep
{
$_
->{url} eq
$s
->url }
@$conf
;
die
"Multiple matches for "
.
$s
->url.
" in $conf_file."
if
@found
> 1;
die
"No matches for "
.
$s
->url.
" in $conf_file."
if
@found
< 1;
my
$key
=
$found
[0]->{key} or
die
"no key for "
.
$s
->url.
" in $conf_file"
;
$s
->logger->info(
"Loaded configuration from $conf_file"
);
$s
->key(
$key
);
return
$s
;
}
sub
login {
my
$c
=
shift
;
my
$got
=
$c
->get(
'/login'
) or
return
;
$c
->get(
'/login'
)->{login} eq
'ok'
or
return
;
return
$c
;
}
sub
use_env {
my
$c
=
shift
;
my
$url
=
$ENV
{GCIS_API_URL} or
die
"please set GCIS_API_URL"
;
$c
->url(
$url
);
return
$c
;
}
sub
get_chapter_map {
my
$c
=
shift
;
my
$report
=
shift
or
die
"no report"
;
my
$all
=
$c
->get(
"/report/$report/chapter?all=1"
) or
die
$c
->url.
' : '
.
$c
->error;
my
%map
=
map
{
$_
->{number} //
$_
->{identifier} =>
$_
->{identifier} }
@$all
;
return
wantarray
?
%map
: \
%map
;
}
sub
tables {
my
$c
=
shift
;
my
%a
=
@_
;
my
$report
=
$a
{report} or
die
"no report"
;
if
(
my
$chapter_number
=
$a
{chapter_number}) {
$c
->{_chapter_map}->{
$report
} //=
$c
->get_chapter_map(
$report
);
$a
{chapter} =
$c
->{_chapter_map}->{
$report
}->{
$chapter_number
};
}
my
$tables
;
if
(
my
$chapter
=
$a
{chapter}) {
$tables
=
$c
->get(
"/report/$report/chapter/$chapter/table?all=1"
) or
die
$c
->error;
}
else
{
$tables
=
$c
->get(
"/report/$report/table?all=1"
) or
die
$c
->error;
}
return
wantarray
?
@$tables
:
$tables
;
}
sub
figures {
my
$c
=
shift
;
my
%a
=
@_
;
my
$report
=
$a
{report} or
die
"no report"
;
if
(
my
$chapter_number
=
$a
{chapter_number}) {
$c
->{_chapter_map}->{
$report
} //=
$c
->get_chapter_map(
$report
);
$a
{chapter} =
$c
->{_chapter_map}->{
$report
}->{
$chapter_number
};
}
my
$figures
;
if
(
my
$chapter
=
$a
{chapter}) {
$figures
=
$c
->get(
"/report/$report/chapter/$chapter/figure?all=1"
) or
die
$c
->error;
}
else
{
$figures
=
$c
->get(
"/report/$report/figure?all=1"
) or
die
$c
->error;
}
return
wantarray
?
@$figures
:
$figures
;
}
sub
findings {
my
$c
=
shift
;
my
%a
=
@_
;
my
$report
=
$a
{report} or
die
"no report"
;
if
(
my
$chapter_number
=
$a
{chapter_number}) {
$c
->{_chapter_map}->{
$report
} //=
$c
->get_chapter_map(
$report
);
$a
{chapter} =
$c
->{_chapter_map}->{
$report
}->{
$chapter_number
};
}
my
$findings
;
if
(
my
$chapter
=
$a
{chapter}) {
$findings
=
$c
->get(
"/report/$report/chapter/$chapter/finding?all=1"
) or
die
$c
->error;
}
else
{
$findings
=
$c
->get(
"/report/$report/finding?all=1"
) or
die
$c
->error;
}
return
wantarray
?
@$findings
:
$findings
;
}
sub
get_form {
my
$c
=
shift
;
my
$obj
=
shift
;
my
$uri
=
$obj
->{uri} or
die
"no uri in "
.Dumper(
$obj
);
if
(
$uri
=~ m[/article]) {
$uri
=~ s[article][article/form/update];
}
else
{
$uri
=~ s[/([^/]+)$][/form/update/$1];
}
return
$c
->get(
$uri
);
}
sub
connect
{
my
$class
=
shift
;
my
%args
=
@_
;
my
$url
=
$args
{url} or
die
"missing url"
;
my
$c
=
$class
->new;
$c
->url(
$url
);
$c
->find_credentials->login or
die
"Failed to log in to $url"
;
return
$c
;
}
1;