line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Furl; |
2
|
10
|
|
|
10
|
|
146433
|
use strict; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
279
|
|
3
|
10
|
|
|
10
|
|
47
|
use warnings; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
223
|
|
4
|
10
|
|
|
10
|
|
3293
|
use utf8; |
|
10
|
|
|
|
|
109
|
|
|
10
|
|
|
|
|
43
|
|
5
|
10
|
|
|
10
|
|
6143
|
use Furl::HTTP; |
|
10
|
|
|
|
|
24
|
|
|
10
|
|
|
|
|
503
|
|
6
|
10
|
|
|
10
|
|
2683
|
use Furl::Request; |
|
10
|
|
|
|
|
25
|
|
|
10
|
|
|
|
|
250
|
|
7
|
10
|
|
|
10
|
|
2763
|
use Furl::Response; |
|
10
|
|
|
|
|
25
|
|
|
10
|
|
|
|
|
271
|
|
8
|
10
|
|
|
10
|
|
63
|
use Carp (); |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
298
|
|
9
|
|
|
|
|
|
|
our $VERSION = '3.12'; |
10
|
|
|
|
|
|
|
|
11
|
10
|
|
|
10
|
|
216
|
use 5.008001; |
|
10
|
|
|
|
|
33
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
$Carp::Internal{+__PACKAGE__} = 1; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
3
|
|
|
3
|
1
|
1143
|
my $class = shift; |
17
|
3
|
|
|
|
|
23
|
bless \(Furl::HTTP->new(header_format => Furl::HTTP::HEADERS_AS_HASHREF(), @_)), $class; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub get { |
21
|
1
|
|
|
1
|
1
|
68
|
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
|
803
|
my ( $self, $url, $headers ) = @_; |
31
|
1
|
|
|
|
|
4
|
$self->request( |
32
|
|
|
|
|
|
|
method => 'HEAD', |
33
|
|
|
|
|
|
|
url => $url, |
34
|
|
|
|
|
|
|
headers => $headers |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub post { |
39
|
2
|
|
|
2
|
1
|
567
|
my ( $self, $url, $headers, $content ) = @_; |
40
|
2
|
|
|
|
|
10
|
$self->request( |
41
|
|
|
|
|
|
|
method => 'POST', |
42
|
|
|
|
|
|
|
url => $url, |
43
|
|
|
|
|
|
|
headers => $headers, |
44
|
|
|
|
|
|
|
content => $content |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub put { |
49
|
1
|
|
|
1
|
1
|
597
|
my ( $self, $url, $headers, $content ) = @_; |
50
|
1
|
|
|
|
|
4
|
$self->request( |
51
|
|
|
|
|
|
|
method => 'PUT', |
52
|
|
|
|
|
|
|
url => $url, |
53
|
|
|
|
|
|
|
headers => $headers, |
54
|
|
|
|
|
|
|
content => $content |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub delete { |
59
|
1
|
|
|
1
|
1
|
513
|
my ( $self, $url, $headers, $content ) = @_; |
60
|
1
|
|
|
|
|
3
|
$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
|
9
|
@_ == 2 ? ${$_[0]}->agent($_[1]) : ${$_[0]}->agent; |
|
1
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
8
|
|
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
|
588
|
my $self = shift; |
80
|
|
|
|
|
|
|
|
81
|
7
|
|
|
|
|
11
|
my %args; |
82
|
7
|
50
|
|
|
|
18
|
if (@_ % 2 == 0) { |
83
|
7
|
|
|
|
|
25
|
%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
|
|
|
|
|
12
|
) = ${$self}->request(%args); |
|
7
|
|
|
|
|
34
|
|
116
|
|
|
|
|
|
|
|
117
|
1
|
|
|
|
|
11
|
my $res = Furl::Response->new($res_minor_version, $res_status, $res_msg, $res_headers, $res_content); |
118
|
1
|
|
|
|
|
5
|
$res->set_request_info(\%args, $captured_req_headers, $captured_req_content); |
119
|
|
|
|
|
|
|
|
120
|
1
|
|
|
|
|
5
|
return $res; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
1; |
124
|
|
|
|
|
|
|
__END__ |