File Coverage

blib/lib/WWW/OneAll.pm
Criterion Covered Total %
statement 18 58 31.0
branch 0 16 0.0
condition 0 8 0.0
subroutine 6 12 50.0
pod 5 5 100.0
total 29 99 29.2


line stmt bran cond sub pod time code
1             package WWW::OneAll;
2              
3 1     1   66026 use strict;
  1         11  
  1         30  
4 1     1   5 use warnings;
  1         2  
  1         33  
5 1     1   5 use Carp qw/croak/;
  1         2  
  1         57  
6 1     1   555 use Mojo::UserAgent;
  1         444974  
  1         9  
7 1     1   79 use Mojo::Util qw(b64_encode);
  1         2  
  1         59  
8              
9             our $VERSION = '0.03';
10              
11 1     1   5 use vars qw/$errstr/;
  1         2  
  1         591  
12 0     0 1   sub errstr { return $errstr }
13              
14             sub new { ## no critic (ArgUnpacking)
15 0     0 1   my $class = shift;
16 0 0         my %args = @_ % 2 ? %{$_[0]} : @_;
  0            
17              
18 0           for (qw/subdomain public_key private_key/) {
19 0 0         $args{$_} || croak "Param $_ is required.";
20             }
21              
22 0   0       $args{endpoint} ||= "https://" . $args{subdomain} . ".api.oneall.com";
23 0   0       $args{timeout} ||= 60; # for ua timeout
24              
25 0           return bless \%args, $class;
26             }
27              
28             sub __ua {
29 0     0     my $self = shift;
30              
31 0 0         return $self->{ua} if exists $self->{ua};
32              
33 0           my $ua = Mojo::UserAgent->new;
34 0           $ua->max_redirects(3);
35 0           $ua->inactivity_timeout($self->{timeout});
36 0           $ua->proxy->detect; # env proxy
37             # $ua->cookie_jar(0);
38 0           $ua->max_connections(100);
39 0           $self->{ua} = $ua;
40              
41 0           return $ua;
42             }
43              
44             sub connections {
45 0     0 1   return (shift)->request('GET', "/connections");
46             }
47              
48             sub connection {
49 0     0 1   my ($self, $connection_token) = @_;
50              
51 0           return $self->request('GET', "/connection/$connection_token");
52             }
53              
54             sub request {
55 0     0 1   my ($self, $method, $url, %params) = @_;
56              
57 0           $errstr = ''; # reset
58              
59             # Format the query params if exist
60 0           my $ref_url_params = delete $params{query_params};
61 0           my $query_params = "?";
62 0 0         $query_params = $query_params . join("&", @$ref_url_params) if $ref_url_params;
63              
64 0           my $ua = $self->__ua;
65 0           my $header = {Authorization => 'Basic ' . b64_encode($self->{public_key} . ':' . $self->{private_key}, '')};
66 0 0         $header->{'Content-Type'} = 'application/json' if %params;
67 0 0         my @extra = %params ? (json => \%params) : ();
68 0           my $tx = $ua->build_tx($method => $self->{endpoint} . $url . '.json' . $query_params => $header => @extra);
69 0           $tx->req->headers->accept('application/json');
70              
71 0           $tx = $ua->start($tx);
72 0 0 0       if ($tx->res->headers->content_type and $tx->res->headers->content_type =~ 'application/json') {
73 0           return $tx->res->json;
74             }
75 0 0         if (!$tx->success) {
76 0           $errstr = "Failed to fetch $url: " . $tx->error->{message};
77 0           return;
78             }
79              
80 0           $errstr = "Unknown Response.";
81 0           return;
82             }
83              
84             1;
85             __END__