File Coverage

lib/Net/Travis/API/UA.pm
Criterion Covered Total %
statement 24 83 28.9
branch 0 24 0.0
condition 0 6 0.0
subroutine 8 19 42.1
pod 1 2 50.0
total 33 134 24.6


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