File Coverage

lib/Net/Travis/API/UA.pm
Criterion Covered Total %
statement 20 84 23.8
branch 0 26 0.0
condition 0 6 0.0
subroutine 7 20 35.0
pod 1 3 33.3
total 28 139 20.1


line stmt bran cond sub pod time code
1 1     1   680 use 5.010; # mro
  1         2  
2 1     1   4 use strict;
  1         1  
  1         20  
3 1     1   3 use warnings;
  1         1  
  1         66  
4              
5             package Net::Travis::API::UA;
6              
7             our $VERSION = '0.002000';
8              
9             # ABSTRACT: Travis Specific User Agent that handles authorization
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13              
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25 1     1   427 use Moo qw( extends has );
  1         9302  
  1         6  
26 1     1   1024 use mro;
  1         2  
  1         4  
27             extends 'HTTP::Tiny';
28              
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51              
52              
53              
54              
55              
56              
57              
58              
59              
60              
61              
62 1     1   25 use Carp qw(croak);
  1         1  
  1         623  
63              
64             sub _package_version {
65 0     0     my $vfield = join q[::], __PACKAGE__, q[VERSION];
66             ## no critic (BuiltinFunctions::ProhibitStringyEval,Lax::ProhibitStringyEval::ExceptForRequire)
67 0 0         if ( eval "defined \$$vfield" ) {
68             ## no critic(ErrorHandling::RequireCheckingReturnValueOfEval)
69 0           return eval "\$$vfield";
70             }
71 0           return;
72             }
73              
74             sub _ua_version {
75 0     0     my ( $self, ) = @_;
76 0 0         return 0 if not defined $self->_package_version;
77 0           return $self->_package_version;
78             }
79 0     0     sub _ua_name { return __PACKAGE__ }
80              
81             sub _ua_flags {
82 0     0     my ( $self, ) = @_;
83 0           my $flags = ['cpan'];
84 0 0         push @{$flags}, 'dev' if not defined $self->_package_version;
  0            
85 0           return $flags;
86             }
87              
88             sub _agent {
89 0     0     my ($self) = @_;
90 0           my $own_ua = sprintf '%s/%s (%s)', $self->_ua_name, $self->_ua_version, ( join q{; }, @{ $self->_ua_flags } );
  0            
91 0           my @agent_strings = ($own_ua);
92 0           for my $class ( @{ mro::get_linear_isa(__PACKAGE__) } ) {
  0            
93 0 0         next unless $class->can('_agent');
94 0 0         next if $class eq __PACKAGE__;
95 0           push @agent_strings, $class->_agent();
96             }
97 0           return join q[ ], @agent_strings;
98             }
99              
100              
101              
102              
103              
104              
105              
106              
107              
108              
109              
110             has 'http_prefix' => (
111             is => ro =>,
112             lazy => 1,
113 0     0     builder => sub { return 'https://api.travis-ci.org' },
114             );
115              
116              
117              
118              
119              
120              
121              
122              
123              
124              
125              
126              
127             has 'http_default_accept_headers' => (
128             is => ro =>,
129             lazy => 1,
130 0     0     builder => sub { return 'application/vnd.travis-ci.2+json' },
131             );
132              
133              
134              
135              
136              
137              
138              
139              
140              
141              
142              
143              
144              
145              
146              
147             has 'authtokens' => (
148             is => rw =>,
149             predicate => 'has_authtokens',
150             );
151              
152              
153              
154              
155              
156              
157              
158              
159              
160             has 'json' => (
161             is => ro =>,
162             lazy => 1,
163             builder => sub {
164 0     0     require JSON::MaybeXS;
165 0           return JSON::MaybeXS->new();
166             },
167             );
168              
169             sub _add_auth_tokens {
170 0     0     my ( $self, $options ) = @_;
171 0 0         $options = {} if not defined $options;
172 0 0         if ( exists $options->{travis_no_auth} ) {
173 0           delete $options->{travis_no_auth};
174 0           return $options;
175             }
176 0 0         return $options unless $self->has_authtokens;
177 0 0 0       return $options if exists $options->{headers} and exists $options->{headers}->{Authorization};
178 0           $options->{headers}->{Authorization} = [ map { 'token ' . $_ } @{ $self->authtokens } ];
  0            
  0            
179 0           return $options;
180             }
181              
182             sub _expand_uri {
183 0     0     my ( $self, $uri ) = @_;
184 0           require URI;
185 0           return URI->new_abs( $uri, $self->http_prefix );
186             }
187              
188             sub FOREIGNBUILDARGS {
189 0     0 0   my ( undef, @elems ) = @_;
190 0           my $hash;
191 0 0 0       if ( 1 == @elems and ref $elems[0] ) {
    0          
192 0           $hash = $elems[0];
193             }
194             elsif ( @elems % 2 == 0 ) {
195 0           $hash = {@elems};
196             }
197             else {
198 0           croak q[Uneven number of parameters or non-ref passed];
199             }
200 0           my %not = map { $_ => 1 } qw( http_prefix http_default_accept_headers authtokens );
  0            
201 0           my %out;
202 0           for my $key ( keys %{$hash} ) {
  0            
203 0 0         next if $not{$key};
204 0           $out{$key} = $hash->{$key};
205             }
206 0           return %out;
207             }
208              
209             sub BUILD {
210 0     0 0   my ($self) = @_;
211 0 0         if( not exists $self->{default_headers}{Accept} ) {
212 0           $self->{default_headers}{Accept} = $self->http_default_accept_headers;
213             }
214 0           return;
215             }
216              
217              
218              
219              
220              
221              
222              
223              
224              
225              
226             sub request {
227 0     0 1   my ( $self, $method, $uri, $opts ) = @_;
228 0           my $result = $self->SUPER::request( $method, $self->_expand_uri($uri), $self->_add_auth_tokens($opts) );
229 0           require Net::Travis::API::UA::Response;
230             return Net::Travis::API::UA::Response->new(
231             json => $self->json,
232 0           %{$result},
  0            
233             );
234             }
235              
236              
237              
238              
239              
240 1     1   5 no Moo;
  1         1  
  1         4  
241              
242             1;
243              
244             __END__