File Coverage

blib/lib/MetaCPAN/Client/Role/HasUA.pm
Criterion Covered Total %
statement 22 22 100.0
branch 3 4 75.0
condition 1 3 33.3
subroutine 6 6 100.0
pod n/a
total 32 35 91.4


line stmt bran cond sub pod time code
1 20     20   190183 use strict;
  20         55  
  20         704  
2 20     20   134 use warnings;
  20         55  
  20         974  
3             package MetaCPAN::Client::Role::HasUA;
4             # ABSTRACT: Role for supporting user-agent attribute
5             $MetaCPAN::Client::Role::HasUA::VERSION = '2.029000';
6 20     20   121 use Moo::Role;
  20         48  
  20         117  
7 20     20   7911 use Carp;
  20         66  
  20         1481  
8 20     20   13750 use HTTP::Tiny;
  20         952888  
  20         5665  
9              
10             has _user_ua => (
11             init_arg => 'ua',
12             is => 'ro',
13             predicate => '_has_user_ua',
14             );
15              
16             has ua => (
17             init_arg => undef,
18             is => 'ro',
19             lazy => 1,
20             builder => '_build_ua',
21             );
22              
23             has ua_args => (
24             is => 'ro',
25             default => sub {
26             [ agent => 'MetaCPAN::Client/'.($MetaCPAN::Client::VERSION||'xx') ]
27             },
28             );
29              
30             sub _build_ua {
31 35     35   2715 my $self = shift;
32              
33             # This level of indirection is so that if a user has not specified a custom UA
34             # MetaCPAN::Client will have its own UA's
35             #
36             # But if the user **has** specified a custom UA, that UA is used for both.
37 35 100       190 if ( $self->_has_user_ua ) {
38 1         4 my $ua = $self->_user_ua;
39 1 50 33     17 croak "cannot use given ua (must support 'get' and 'post' methods)"
40             unless $ua->can("get") and $ua->can("post");
41              
42 1         8 return $self->_user_ua;
43             }
44              
45 34         76 return HTTP::Tiny->new( @{ $self->ua_args } );
  34         501  
46             }
47              
48             1;
49              
50             __END__