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   156854 use strict;
  20         45  
  20         587  
2 20     20   96 use warnings;
  20         47  
  20         831  
3             package MetaCPAN::Client::Role::HasUA;
4             # ABSTRACT: Role for supporting user-agent attribute
5             $MetaCPAN::Client::Role::HasUA::VERSION = '2.030000';
6 20     20   111 use Moo::Role;
  20         39  
  20         156  
7 20     20   6547 use Carp;
  20         57  
  20         1241  
8 20     20   10793 use HTTP::Tiny;
  20         773997  
  20         6740  
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             verify_SSL => 1 ]
28             },
29             );
30              
31             sub _build_ua {
32 35     35   2172 my $self = shift;
33              
34             # This level of indirection is so that if a user has not specified a custom UA
35             # MetaCPAN::Client will have its own UA's
36             #
37             # But if the user **has** specified a custom UA, that UA is used for both.
38 35 100       171 if ( $self->_has_user_ua ) {
39 1         4 my $ua = $self->_user_ua;
40 1 50 33     22 croak "cannot use given ua (must support 'get' and 'post' methods)"
41             unless $ua->can("get") and $ua->can("post");
42              
43 1         10 return $self->_user_ua;
44             }
45              
46 34         68 return HTTP::Tiny->new( @{ $self->ua_args } );
  34         427  
47             }
48              
49             1;
50              
51             __END__