File Coverage

blib/lib/Catmandu/AlephX/UserAgent/LWP.pm
Criterion Covered Total %
statement 18 54 33.3
branch 0 10 0.0
condition 0 8 0.0
subroutine 6 12 50.0
pod 0 1 0.0
total 24 85 28.2


line stmt bran cond sub pod time code
1             package Catmandu::AlephX::UserAgent::LWP;
2 1     1   87844 use Catmandu::Sane;
  1         386523  
  1         7  
3 1     1   290 use Carp qw(confess);
  1         2  
  1         55  
4 1     1   5 use Moo;
  1         1  
  1         6  
5 1     1   953 use LWP::UserAgent;
  1         70072  
  1         34  
6 1     1   11 use URI::Escape;
  1         2  
  1         64  
7 1     1   6 use Catmandu::Util qw(:check :is);
  1         3  
  1         5556  
8              
9             our $VERSION = "1.071";
10              
11             with qw(Catmandu::AlephX::UserAgent);
12              
13             has ua => (
14             is => 'ro',
15             lazy => 1,
16             default => sub {
17             my $ua = LWP::UserAgent->new(
18             cookie_jar => {}
19             );
20             if(is_string($ENV{LWP_TRACE})){
21             $ua->add_handler("request_send", sub { shift->dump; return });
22             $ua->add_handler("response_done", sub { shift->dump; return });
23             }
24             $ua;
25             }
26             );
27              
28             sub request {
29 0     0 0   my($self,$params,$method)=@_;
30              
31             #default_args
32 0           $params = { %{ $self->default_args() }, %$params };
  0            
33              
34 0   0       $method ||= "GET";
35 0           my $res;
36 0 0         if(uc($method) eq "GET"){
    0          
37 0           $res = $self->_get($params);
38             }elsif(uc($method) eq "POST"){
39 0           $res = $self->_post($params);
40             }else{
41 0           confess "method $method not supported";
42             }
43 0           _validate_web_response($res);
44              
45 0           $res;
46             }
47              
48             sub _validate_web_response {
49 0     0     my($res) = @_;
50 0 0         $res->is_error && confess($res->content);
51             }
52             sub _post {
53 0     0     my($self,$data)=@_;
54 0           $self->ua->post($self->url,_construct_params_as_array($data));
55             }
56             sub _construct_query {
57 0     0     my $data = shift;
58 0           my @parts = ();
59 0           for my $key(keys %$data){
60 0 0         if(is_array_ref($data->{$key})){
61 0           for my $val(@{ $data->{$key} }){
  0            
62 0   0       push @parts,URI::Escape::uri_escape($key)."=".URI::Escape::uri_escape($val // "");
63             }
64             }else{
65 0   0       push @parts,URI::Escape::uri_escape($key)."=".URI::Escape::uri_escape($data->{$key} // "");
66             }
67             }
68 0           join("&",@parts);
69             }
70             sub _construct_params_as_array {
71 0     0     my $params = shift;
72 0           my @array = ();
73 0           for my $key(keys %$params){
74 0 0         if(is_array_ref($params->{$key})){
75             #PHP only recognizes 'arrays' when their keys are appended by '[]' (yuk!)
76 0           for my $val(@{ $params->{$key} }){
  0            
77 0           push @array,$key => $val;
78             }
79             }else{
80 0           push @array,$key => $params->{$key};
81             }
82             }
83 0           return \@array;
84             }
85             sub _get {
86 0     0     my($self,$data)=@_;
87 0   0       my $query = _construct_query($data) || "";
88 0           $self->ua->get($self->url."?$query");
89             }
90              
91             1;