File Coverage

blib/lib/Furl.pm
Criterion Covered Total %
statement 47 61 77.0
branch 3 4 75.0
condition n/a
subroutine 16 17 94.1
pod 9 9 100.0
total 75 91 82.4


line stmt bran cond sub pod time code
1             package Furl;
2 10     10   152012 use strict;
  10         18  
  10         281  
3 10     10   53 use warnings;
  10         17  
  10         262  
4 10     10   2898 use utf8;
  10         114  
  10         67  
5 10     10   3593 use Furl::HTTP;
  10         28  
  10         570  
6 10     10   2777 use Furl::Request;
  10         25  
  10         265  
7 10     10   2959 use Furl::Response;
  10         27  
  10         248  
8 10     10   58 use Carp ();
  10         31  
  10         246  
9             our $VERSION = '3.13';
10              
11 10     10   242 use 5.008001;
  10         32  
12              
13             $Carp::Internal{+__PACKAGE__} = 1;
14              
15             sub new {
16 3     3 1 1381 my $class = shift;
17 3         32 bless \(Furl::HTTP->new(header_format => Furl::HTTP::HEADERS_AS_HASHREF(), @_)), $class;
18             }
19              
20             sub get {
21 1     1 1 77 my ( $self, $url, $headers ) = @_;
22 1         5 $self->request(
23             method => 'GET',
24             url => $url,
25             headers => $headers
26             );
27             }
28              
29             sub head {
30 1     1 1 933 my ( $self, $url, $headers ) = @_;
31 1         6 $self->request(
32             method => 'HEAD',
33             url => $url,
34             headers => $headers
35             );
36             }
37              
38             sub post {
39 2     2 1 658 my ( $self, $url, $headers, $content ) = @_;
40 2         16 $self->request(
41             method => 'POST',
42             url => $url,
43             headers => $headers,
44             content => $content
45             );
46             }
47              
48             sub put {
49 1     1 1 569 my ( $self, $url, $headers, $content ) = @_;
50 1         6 $self->request(
51             method => 'PUT',
52             url => $url,
53             headers => $headers,
54             content => $content
55             );
56             }
57              
58             sub delete {
59 1     1 1 538 my ( $self, $url, $headers, $content ) = @_;
60 1         6 $self->request(
61             method => 'DELETE',
62             url => $url,
63             headers => $headers,
64             content => $content
65             );
66             }
67              
68              
69             sub agent {
70 3 100   3 1 13 @_ == 2 ? ${$_[0]}->agent($_[1]) : ${$_[0]}->agent;
  1         5  
  2         9  
71             }
72              
73             sub env_proxy {
74 0     0 1 0 my $self = shift;
75 0         0 $$self->env_proxy;
76             }
77              
78             sub request {
79 7     7 1 539 my $self = shift;
80              
81 7         14 my %args;
82 7 50       27 if (@_ % 2 == 0) {
83 7         37 %args = @_;
84             } else {
85             # convert HTTP::Request to hash for Furl::HTTP.
86              
87 0         0 my $req = shift;
88 0         0 %args = @_;
89 0         0 my $req_headers= $req->headers;
90 0         0 $req_headers->remove_header('Host'); # suppress duplicate Host header
91             my $headers = +[
92             map {
93 0         0 my $k = $_;
  0         0  
94 0         0 map { ( $k => $_ ) } $req_headers->header($_);
  0         0  
95             } $req_headers->header_field_names
96             ];
97              
98 0         0 $args{url} = $req->uri;
99 0         0 $args{method} = $req->method;
100 0         0 $args{content} = $req->content;
101 0         0 $args{headers} = $headers;
102             }
103              
104             my (
105             $res_minor_version,
106             $res_status,
107             $res_msg,
108             $res_headers,
109             $res_content,
110             $captured_req_headers,
111             $captured_req_content,
112             $captured_res_headers,
113             $captured_res_content,
114             $request_info,
115 7         14 ) = ${$self}->request(%args);
  7         49  
116              
117 1         12 my $res = Furl::Response->new($res_minor_version, $res_status, $res_msg, $res_headers, $res_content);
118 1         8 $res->set_request_info(\%args, $captured_req_headers, $captured_req_content);
119              
120 1         8 return $res;
121             }
122              
123             1;
124             __END__