File Coverage

blib/lib/WWW/OneAll.pm
Criterion Covered Total %
statement 18 55 32.7
branch 0 14 0.0
condition 0 8 0.0
subroutine 6 12 50.0
pod 4 5 80.0
total 28 94 29.7


line stmt bran cond sub pod time code
1             package WWW::OneAll;
2              
3 1     1   13373 use strict;
  1         1  
  1         25  
4 1     1   4 use warnings;
  1         1  
  1         22  
5 1     1   3 use Carp qw/croak/;
  1         1  
  1         52  
6 1     1   474 use Mojo::UserAgent;
  1         193543  
  1         9  
7 1     1   33 use Mojo::Util qw(b64_encode);
  1         2  
  1         46  
8              
9             our $VERSION = '0.01';
10              
11 1     1   4 use vars qw/$errstr/;
  1         1  
  1         372  
12 0     0 0   sub errstr { $errstr }
13              
14             sub new {
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 0           my $ua = $self->__ua;
60             my $header = {
61 0           Authorization => 'Basic ' . b64_encode($self->{public_key} . ':' . $self->{private_key}, '')
62             };
63 0 0         $header->{'Content-Type'} = 'application/json' if %params;
64 0 0         my @extra = %params ? (json => \%params) : ();
65 0           my $tx = $ua->build_tx($method => $self->{endpoint} . $url . '.json' => $header => @extra);
66 0           $tx->req->headers->accept('application/json');
67              
68 0           $tx = $ua->start($tx);
69 0 0 0       if ($tx->res->headers->content_type and $tx->res->headers->content_type =~ 'application/json') {
70 0           return $tx->res->json;
71             }
72 0 0         if (! $tx->success) {
73 0           $errstr = "Failed to fetch $url: " . $tx->error->{message};
74 0           return;
75             }
76              
77 0           $errstr = "Unknown Response.";
78 0           return;
79             }
80              
81             1;
82             __END__