File Coverage

blib/lib/Gcis/Client.pm

Criterion	Covered	Total	%
statement	27	185	14.5
branch	0	108	0.0
condition	0	21	0.0
subroutine	9	25	36.0
pod	8	16	50.0
total	44	355	12.3

package Gcis::Client;
use Mojo::UserAgent;
use Mojo::Base -base;
use Mojo::Log;
use JSON::XS;
use YAML::XS qw/LoadFile/;
use Path::Class qw/file/;
use Data::Dumper;
use Time::HiRes qw/sleep/;
use v5.14;

our $VERSION = '0.11';

has url      => 'http://localhost:3000';
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 or die "missing path";
    my $params = shift;
    if (defined($s->delay)) {
        $s->logger->debug("sleeping for ".$s->delay.'s');
        sleep $s->delay;
    }
    my $url;
    if ($params) {
        $url = Mojo::URL->new($s->url);
        $url->path($path);
        $url->query(%$params);
    } else {
        $url = Mojo::URL->new($s->url.$path);
    }
    my $tx = $s->ua->get($url);
    $s->tx($tx);
    my $res = $tx->success;
    unless ($res) {
        if ($tx->res->code && $tx->res->code == 404) {
            # $s->logger->debug("not found : $path");
            $s->error("not found : $path");
            return;
        }
        $s->error($tx->error->{message});
        $s->logger->error($tx->error->{message});
        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 or Carp::confess "missing path";
    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("got an error $path : ".Dumper($tx->error->{message}).$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->{message});
        $s->logger->error($tx->error->{message});
        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->error(join "\n",$tx->error->{message},$tx->res->body);
        $s->logger->error($path." : ".$tx->error->{message});
        $s->logger->error($tx->res->body);
        return;
    };
    return unless $res;
    my $json = $res->json or return $res->body;
    return $res->json;
}

sub add_file_url {
    my $s = shift;
    my $gcid = shift;
    my $args = shift;
    my $path = $gcid;
    $path =~ s[/([^/]+)$][/files/$1];
    $s->post($path => $args);
}

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 {
        # The last backslash becomes /form/update
        $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;

__END__