line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
2
|
|
|
|
|
|
|
## Asynchronous HTTP Request and Promise - ~/lib/HTTP/Promise.pm |
3
|
|
|
|
|
|
|
## Version v0.3.3 |
4
|
|
|
|
|
|
|
## Copyright(c) 2023 DEGUEST Pte. Ltd. |
5
|
|
|
|
|
|
|
## Author: Jacques Deguest <jack@deguest.jp> |
6
|
|
|
|
|
|
|
## Created 2021/05/06 |
7
|
|
|
|
|
|
|
## Modified 2023/10/10 |
8
|
|
|
|
|
|
|
## All rights reserved. |
9
|
|
|
|
|
|
|
## |
10
|
|
|
|
|
|
|
## |
11
|
|
|
|
|
|
|
## This program is free software; you can redistribute it and/or modify it |
12
|
|
|
|
|
|
|
## under the same terms as Perl itself. |
13
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
14
|
|
|
|
|
|
|
package HTTP::Promise; |
15
|
|
|
|
|
|
|
BEGIN |
16
|
|
|
|
|
|
|
{ |
17
|
2
|
|
|
2
|
|
701739
|
use strict; |
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
60
|
|
18
|
2
|
|
|
2
|
|
10
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
50
|
|
19
|
2
|
|
|
2
|
|
10
|
use warnings::register; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
231
|
|
20
|
2
|
|
|
2
|
|
11
|
use parent qw( Module::Generic ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
45
|
|
21
|
2
|
|
|
|
|
326
|
use vars qw( $VERSION $AUTOLOAD $CONTENT_SIZE_THRESHOLD $CRLF |
22
|
|
|
|
|
|
|
$DEFAULT_PROTOCOL $EXCEPTION_CLASS $EXTENSION_VARY |
23
|
|
|
|
|
|
|
$IS_WIN32 $HTTP_TOKEN $HTTP_QUOTED_STRING $BUFFER_SIZE |
24
|
|
|
|
|
|
|
$MAX_HEADERS_SIZE $MAX_BODY_IN_MEMORY_SIZE $EXPECT_THRESHOLD $DEFAULT_MIME_TYPE |
25
|
2
|
|
|
2
|
|
101741
|
$SERIALISER @EXPORT_OK ); |
|
2
|
|
|
|
|
4
|
|
26
|
2
|
|
|
2
|
|
1286
|
use Cookie; |
|
2
|
|
|
|
|
1781399
|
|
|
2
|
|
|
|
|
21
|
|
27
|
2
|
|
|
2
|
|
2856
|
use Cookie::Jar; |
|
2
|
|
|
|
|
452924
|
|
|
2
|
|
|
|
|
41
|
|
28
|
2
|
|
|
2
|
|
1882
|
use Errno qw( EAGAIN ECONNRESET EINPROGRESS EINTR EWOULDBLOCK ECONNABORTED EISCONN ); |
|
2
|
|
|
|
|
3113
|
|
|
2
|
|
|
|
|
286
|
|
29
|
2
|
|
|
2
|
|
821
|
use HTTP::Promise::Exception; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
31
|
|
30
|
2
|
|
|
2
|
|
1728
|
use HTTP::Promise::IO; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
40
|
|
31
|
2
|
|
|
2
|
|
1562
|
use HTTP::Promise::Pool; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
19
|
|
32
|
2
|
|
|
2
|
|
1518
|
use HTTP::Promise::Request; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
32
|
|
33
|
2
|
|
|
2
|
|
1531
|
use HTTP::Promise::Response; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
23
|
|
34
|
2
|
|
|
2
|
|
541
|
use HTTP::Promise::Status qw( :all ); |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
14
|
|
35
|
|
|
|
|
|
|
# use Nice::Try; |
36
|
2
|
|
|
2
|
|
1781
|
use Promise::Me; |
|
2
|
|
|
|
|
9579576
|
|
|
2
|
|
|
|
|
15
|
|
37
|
2
|
|
|
2
|
|
9930703
|
use Scalar::Util (); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
51
|
|
38
|
2
|
|
|
2
|
|
12
|
use URI; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
57
|
|
39
|
2
|
|
|
2
|
|
15
|
use URI::Escape::XS (); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
113
|
|
40
|
|
|
|
|
|
|
# < 0 so we recognise those as system errors |
41
|
|
|
|
|
|
|
use constant { |
42
|
2
|
|
|
|
|
680
|
ERROR_EINTR => ( abs( Errno::EINTR ) * -1 ), |
43
|
|
|
|
|
|
|
TYPE_URL_ENCODED => 'application/x-www-form-urlencoded', |
44
|
2
|
|
|
2
|
|
12
|
}; |
|
2
|
|
|
|
|
4
|
|
45
|
2
|
|
|
2
|
|
14
|
our @EXPORT_OK = qw( fetch ); |
46
|
|
|
|
|
|
|
# "\r\n" is not portable |
47
|
2
|
|
|
|
|
4
|
our $CRLF = "\015\012"; |
48
|
2
|
|
|
|
|
3
|
our $DEFAULT_PROTOCOL = 'HTTP/1.1'; |
49
|
2
|
|
|
|
|
4
|
our $EXCEPTION_CLASS = 'HTTP::Promise::Exception'; |
50
|
2
|
|
|
|
|
12
|
our $HTTP_TOKEN = qr/[^\x00-\x31\x7F]+/; |
51
|
2
|
|
|
|
|
7
|
our $HTTP_QUOTED_STRING = qr/"([^"]+|\\.)*"/; |
52
|
|
|
|
|
|
|
# 10K |
53
|
2
|
|
|
|
|
4
|
our $BUFFER_SIZE = 10240000; |
54
|
2
|
|
|
|
|
4
|
our $MAX_HEADERS_SIZE = 8192; |
55
|
|
|
|
|
|
|
# 256Kb |
56
|
2
|
|
|
|
|
3
|
our $MAX_BODY_IN_MEMORY_SIZE = 102400; |
57
|
|
|
|
|
|
|
# 1Mb |
58
|
2
|
|
|
|
|
4
|
our $EXPECT_THRESHOLD = 1024000000; |
59
|
2
|
|
|
|
|
2
|
our $EXTENSION_VARY = 1; |
60
|
2
|
|
|
|
|
4
|
our $DEFAULT_MIME_TYPE = 'application/octet-stream'; |
61
|
2
|
|
|
|
|
6
|
our $SERIALISER = $Promise::Me::SERIALISER; |
62
|
2
|
|
|
|
|
44
|
our $VERSION = 'v0.3.3'; |
63
|
|
|
|
|
|
|
}; |
64
|
|
|
|
|
|
|
|
65
|
2
|
|
|
2
|
|
15
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
63
|
|
66
|
2
|
|
|
2
|
|
14
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
20859
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub init |
69
|
|
|
|
|
|
|
{ |
70
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
71
|
0
|
|
|
|
|
|
$self->{accept_language} = []; |
72
|
0
|
|
|
|
|
|
$self->{accept_encoding} = 'auto'; |
73
|
0
|
|
|
|
|
|
$self->{agent} = qq{HTTP-Promise/$VERSION (perl; +https://metacpan.org/pod/HTTP::Promise)}; |
74
|
0
|
|
|
|
|
|
$self->{auto_switch_https} = 1; |
75
|
0
|
|
|
|
|
|
$self->{buffer_size} = $BUFFER_SIZE; |
76
|
0
|
|
|
|
|
|
$self->{cookie_jar} = Cookie::Jar->new; |
77
|
0
|
|
|
|
|
|
$self->{default_headers} = undef; |
78
|
0
|
|
0
|
|
|
|
$self->{default_protocol} = ( $DEFAULT_PROTOCOL || 'HTTP/1.1' ); |
79
|
|
|
|
|
|
|
# DNT -> Do not track header field |
80
|
0
|
|
|
|
|
|
$self->{dnt} = undef; |
81
|
0
|
|
|
|
|
|
$self->{expect_threshold} = $EXPECT_THRESHOLD; |
82
|
0
|
|
|
|
|
|
$self->{ext_vary} = $EXTENSION_VARY; |
83
|
0
|
|
|
|
|
|
$self->{from} = undef; |
84
|
0
|
|
|
|
|
|
$self->{inactivity_timeout} = 600; |
85
|
0
|
|
|
|
|
|
$self->{local_host} = undef; |
86
|
0
|
|
|
|
|
|
$self->{local_port} = undef; |
87
|
0
|
|
|
|
|
|
$self->{max_body_in_memory_size} = $MAX_BODY_IN_MEMORY_SIZE; |
88
|
0
|
|
|
|
|
|
$self->{max_headers_size} = $MAX_HEADERS_SIZE; |
89
|
0
|
|
|
|
|
|
$self->{max_redirect} = 7; |
90
|
0
|
|
|
|
|
|
$self->{max_size} = undef; |
91
|
0
|
|
|
|
|
|
$self->{medium} = $Promise::Me::SHARE_MEDIUM; |
92
|
0
|
|
|
|
|
|
$self->{no_proxy} = []; |
93
|
0
|
|
0
|
|
|
|
$self->{proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || undef; |
94
|
0
|
|
|
|
|
|
$self->{proxy_authorization} = undef; |
95
|
0
|
|
|
|
|
|
$self->{requests_redirectable} = [qw( GET HEAD )]; |
96
|
0
|
|
|
|
|
|
$self->{send_te} = 1; |
97
|
0
|
|
|
|
|
|
$self->{serialiser} = $SERIALISER; |
98
|
0
|
|
|
|
|
|
$self->{shared_mem_size} = $Promise::Me::RESULT_MEMORY_SIZE; |
99
|
0
|
|
|
0
|
|
|
$self->{stop_if} = sub{}; |
100
|
0
|
|
|
|
|
|
$self->{threshold} = $CONTENT_SIZE_THRESHOLD; |
101
|
|
|
|
|
|
|
# 3 minutes |
102
|
0
|
|
|
|
|
|
$self->{timeout} = 180; |
103
|
0
|
|
|
|
|
|
$self->{use_content_file} = 0; |
104
|
0
|
|
|
|
|
|
$self->{use_promise} = 1; |
105
|
0
|
|
|
|
|
|
$self->{_init_strict_use_sub} = 1; |
106
|
0
|
|
|
|
|
|
$self->{_exception_class} = $EXCEPTION_CLASS; |
107
|
0
|
0
|
|
|
|
|
$self->SUPER::init( @_ ) || return( $self->pass_error ); |
108
|
0
|
|
|
|
|
|
my $headers = $self->default_headers; |
109
|
0
|
0
|
|
|
|
|
if( $headers ) |
110
|
|
|
|
|
|
|
{ |
111
|
0
|
0
|
|
|
|
|
unless( $self->connection_header ) |
112
|
|
|
|
|
|
|
{ |
113
|
0
|
|
|
|
|
|
my $connection_header = 'keep-alive'; |
114
|
0
|
0
|
|
|
|
|
if( $headers->exists( 'connection' ) ) |
115
|
|
|
|
|
|
|
{ |
116
|
0
|
|
|
|
|
|
$connection_header = $headers->get( 'connection' ); |
117
|
|
|
|
|
|
|
} |
118
|
0
|
|
|
|
|
|
$self->{connection_header} = $connection_header; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
else |
122
|
|
|
|
|
|
|
{ |
123
|
0
|
0
|
|
|
|
|
$self->default_headers( HTTP::Promise::Headers->new ) || |
124
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Headers->error ) ); |
125
|
|
|
|
|
|
|
} |
126
|
0
|
|
|
|
|
|
$self->{_pool} = HTTP::Promise::Pool->new; |
127
|
0
|
|
|
|
|
|
return( $self ); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
0
|
1
|
|
sub accept_language { return( shift->_set_get_array_as_object( 'accept_language', @_ ) ); } |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
0
|
1
|
|
sub accept_encoding { return( shift->_set_get_scalar_as_object( 'accept_encoding', @_ ) ); } |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# NOTE: request parameter |
135
|
0
|
|
|
0
|
1
|
|
sub agent { return( shift->_set_get_scalar_as_object( 'agent', @_ ) ); } |
136
|
|
|
|
|
|
|
|
137
|
0
|
|
|
0
|
1
|
|
sub auto_switch_https { return( shift->_set_get_boolean( 'auto_switch_https', @_ ) ); } |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
0
|
1
|
|
sub buffer_size { return( shift->_set_get_number( 'buffer_size', @_ ) ); } |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub clone |
142
|
|
|
|
|
|
|
{ |
143
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
144
|
0
|
|
|
|
|
|
my $new = $self->SUPER::clone; |
145
|
0
|
0
|
|
|
|
|
if( $self->{default_headers} ) |
146
|
|
|
|
|
|
|
{ |
147
|
0
|
|
|
|
|
|
$new->{default_headers} = $self->{default_headers}->clone; |
148
|
|
|
|
|
|
|
} |
149
|
0
|
|
|
|
|
|
$new->{_pool} = HTTP::Promise::Pool->new; |
150
|
0
|
|
|
|
|
|
return( $new ); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
0
|
1
|
|
sub connection_header { return( shift->_set_get_scalar_as_object( 'connection_header', @_ ) ); } |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# NOTE: request parameter |
156
|
0
|
|
|
0
|
1
|
|
sub cookie_jar { return( shift->_set_get_scalar( 'cookie_jar', @_ ) ); } |
157
|
|
|
|
|
|
|
|
158
|
0
|
|
|
0
|
1
|
|
sub decodable { return( HTTP::Promise::Stream->decodable( @_ ) ); } |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# NOTE: request parameter |
161
|
0
|
|
|
0
|
1
|
|
sub default_header { return( shift->default_headers->header( @_ ) ); } |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# NOTE: request parameter |
164
|
0
|
|
|
0
|
1
|
|
sub default_headers { return( shift->_set_get_object_without_init( 'default_headers', [qw( HTTP::Promise::Headers HTTP::Headers )], @_ ) ); } |
165
|
|
|
|
|
|
|
|
166
|
0
|
|
|
0
|
1
|
|
sub default_protocol { return( shift->_set_get_scalar_as_object( 'default_protocol', @_ ) ); } |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub delete |
169
|
|
|
|
|
|
|
{ |
170
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
171
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
172
|
|
|
|
|
|
|
{ |
173
|
|
|
|
|
|
|
my $prom = Promise::Me->new(sub |
174
|
|
|
|
|
|
|
{ |
175
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
176
|
0
|
|
|
|
|
|
my $req = HTTP::Promise::Request->new( 'DELETE' => @_ ) || |
177
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Request->error ) ); |
178
|
0
|
|
|
|
|
|
my $resp = $self->send( $req ) || return( $reject->( $self->error ) ); |
179
|
0
|
|
|
|
|
|
return( $resolve->( $resp ) ); |
180
|
|
|
|
|
|
|
}, |
181
|
|
|
|
|
|
|
{ |
182
|
|
|
|
|
|
|
args => [@_], |
183
|
|
|
|
|
|
|
( defined( $self->{serialiser} ) ? ( serialiser => $self->{serialiser} ) : () ), |
184
|
|
|
|
|
|
|
( defined( $self->{medium} ) ? ( medium => $self->{medium} ) : () ), |
185
|
0
|
|
0
|
|
|
|
( defined( $self->{shared_mem_size} ) ? ( result_shared_mem_size => $self->{shared_mem_size} ) : () ), |
186
|
|
|
|
|
|
|
}) || return( $self->pass_error( Promise::Me->error ) ); |
187
|
0
|
|
|
|
|
|
return( $prom ); |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
else |
190
|
|
|
|
|
|
|
{ |
191
|
0
|
|
0
|
|
|
|
my $req = HTTP::Promise::Request->new( 'DELETE' => @_ ) || |
192
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Request->error ) ); |
193
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req ) || |
194
|
|
|
|
|
|
|
return( $self->pass_error ); |
195
|
0
|
|
|
|
|
|
return( $resp ); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
0
|
1
|
|
sub dnt { return( shift->_set_get_boolean( 'dnt', @_ ) ); } |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
0
|
1
|
|
sub expect_threshold { return( shift->_set_get_number( 'expect_threshold', @_ ) ); } |
202
|
|
|
|
|
|
|
|
203
|
0
|
|
|
0
|
1
|
|
sub ext_vary { return( shift->_set_get_boolean( 'ext_vary', @_ ) ); } |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub fetch |
206
|
|
|
|
|
|
|
{ |
207
|
0
|
|
|
0
|
1
|
|
my $self; |
208
|
0
|
0
|
0
|
|
|
|
if( Scalar::Util::blessed( $_[0] ) && $_[0]->isa( __PACKAGE__ ) ) |
209
|
|
|
|
|
|
|
{ |
210
|
0
|
|
|
|
|
|
$self = shift( @_ ); |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
else |
213
|
|
|
|
|
|
|
{ |
214
|
0
|
|
|
|
|
|
$self = __PACKAGE__->new; |
215
|
|
|
|
|
|
|
} |
216
|
0
|
|
|
|
|
|
my $meth = 'get'; |
217
|
0
|
|
|
|
|
|
for( my $i = 0; $i < scalar( @_ ); $i += 2 ) |
218
|
|
|
|
|
|
|
{ |
219
|
0
|
0
|
|
|
|
|
if( $_[$i] eq 'method' ) |
220
|
|
|
|
|
|
|
{ |
221
|
0
|
|
|
|
|
|
$meth = $_[$i + 1]; |
222
|
0
|
|
|
|
|
|
splice( @_, $i, 2 ); |
223
|
0
|
|
|
|
|
|
last; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
} |
226
|
0
|
0
|
|
|
|
|
return( $self->error( "Unknown HTTP method \"${meth}\"." ) ) if( $meth !~ /^$HTTP::Promise::Request::KNOWN_METHODS_I$/i ); |
227
|
0
|
|
0
|
|
|
|
my $code = $self->can( $meth ) || |
228
|
|
|
|
|
|
|
return( $self->error( "Somehow the HTTP method \"${meth}\" is not supported by ", ref( $self ) ) ); |
229
|
0
|
|
|
|
|
|
return( $code->( $self, @_ ) ); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
0
|
|
|
0
|
1
|
|
sub file { return( shift->_set_get_object_without_init( 'file', 'Module::Generic::File', @_ ) ); } |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# NOTE: request parameter |
235
|
0
|
|
|
0
|
1
|
|
sub from { return( shift->_set_get_scalar_as_object( 'from', @_ ) ); } |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub get |
238
|
|
|
|
|
|
|
{ |
239
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
240
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
241
|
|
|
|
|
|
|
{ |
242
|
|
|
|
|
|
|
my $prom = Promise::Me->new(sub |
243
|
|
|
|
|
|
|
{ |
244
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
245
|
0
|
|
|
|
|
|
my $req = $self->_make_request_query( GET => @_ ) || |
246
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Request->error ) ); |
247
|
0
|
|
|
|
|
|
my $resp = $self->send( $req ) || return( $reject->( $self->error ) ); |
248
|
0
|
|
|
|
|
|
return( $resolve->( $resp ) ); |
249
|
|
|
|
|
|
|
}, |
250
|
|
|
|
|
|
|
{ |
251
|
|
|
|
|
|
|
args => [@_], |
252
|
|
|
|
|
|
|
( defined( $self->{serialiser} ) ? ( serialiser => $self->{serialiser} ) : () ), |
253
|
|
|
|
|
|
|
( defined( $self->{medium} ) ? ( medium => $self->{medium} ) : () ), |
254
|
0
|
|
0
|
|
|
|
( defined( $self->{shared_mem_size} ) ? ( result_shared_mem_size => $self->{shared_mem_size} ) : () ), |
255
|
|
|
|
|
|
|
}) || return( $self->pass_error( Promise::Me->error ) ); |
256
|
0
|
|
|
|
|
|
return( $prom ); |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
else |
259
|
|
|
|
|
|
|
{ |
260
|
0
|
|
0
|
|
|
|
my $req = $self->_make_request_query( GET => @_ ) || |
261
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Request->error ) ); |
262
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req ) || |
263
|
|
|
|
|
|
|
return( $self->pass_error ); |
264
|
0
|
|
|
|
|
|
return( $resp ); |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub head |
269
|
|
|
|
|
|
|
{ |
270
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
271
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
272
|
|
|
|
|
|
|
{ |
273
|
|
|
|
|
|
|
my $prom = Promise::Me->new(sub |
274
|
|
|
|
|
|
|
{ |
275
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
276
|
0
|
|
|
|
|
|
my $req = $self->_make_request_query( HEAD => @_ ) || |
277
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Request->error ) ); |
278
|
0
|
|
|
|
|
|
my $resp = $self->send( $req ) || return( $reject->( $self->error ) ); |
279
|
0
|
|
|
|
|
|
return( $resolve->( $resp ) ); |
280
|
|
|
|
|
|
|
}, |
281
|
|
|
|
|
|
|
{ |
282
|
|
|
|
|
|
|
args => [@_], |
283
|
|
|
|
|
|
|
( defined( $self->{serialiser} ) ? ( serialiser => $self->{serialiser} ) : () ), |
284
|
|
|
|
|
|
|
( defined( $self->{medium} ) ? ( medium => $self->{medium} ) : () ), |
285
|
0
|
|
0
|
|
|
|
( defined( $self->{shared_mem_size} ) ? ( result_shared_mem_size => $self->{shared_mem_size} ) : () ), |
286
|
|
|
|
|
|
|
}) || return( $self->pass_error( Promise::Me->error ) ); |
287
|
0
|
|
|
|
|
|
return( $prom ); |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
else |
290
|
|
|
|
|
|
|
{ |
291
|
0
|
|
0
|
|
|
|
my $req = $self->_make_request_query( HEAD => @_ ) || |
292
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Request->error ) ); |
293
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req ) || |
294
|
|
|
|
|
|
|
return( $self->pass_error ); |
295
|
0
|
|
|
|
|
|
return( $resp ); |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
0
|
|
|
0
|
1
|
|
sub httpize_datetime { return( shift->_datetime( @_ ) ); } |
300
|
|
|
|
|
|
|
|
301
|
0
|
|
|
0
|
1
|
|
sub inactivity_timeout { return( shift->_set_get_number( 'inactivity_timeout', @_ ) ); } |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
sub is_protocol_supported |
304
|
|
|
|
|
|
|
{ |
305
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
306
|
0
|
|
0
|
|
|
|
my $scheme = shift( @_ ) || |
307
|
|
|
|
|
|
|
return( $self->error( "No scheme value was provided." ) ); |
308
|
0
|
0
|
|
|
|
|
if( $self->_is_object( $scheme ) ) |
309
|
|
|
|
|
|
|
{ |
310
|
0
|
0
|
|
|
|
|
return( $self->error( "Object provided (", overload::StrVal( $scheme ), ") does not support the 'scheme' method." ) ) if( !$scheme->can( 'scheme' ) ); |
311
|
0
|
|
|
|
|
|
$scheme = $scheme->scheme; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
else |
314
|
|
|
|
|
|
|
{ |
315
|
0
|
0
|
|
|
|
|
return( $self->error( "Illegal scheme '$scheme' passed to is_protocol_supported" ) ) if( $scheme =~ /\W/ ); |
316
|
0
|
|
|
|
|
|
$scheme = lc $scheme; |
317
|
|
|
|
|
|
|
} |
318
|
0
|
0
|
0
|
|
|
|
return(1) if( $scheme eq 'http' || $scheme eq 'https' ); |
319
|
0
|
|
|
|
|
|
return(0); |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
0
|
|
|
0
|
1
|
|
sub languages { return( shift->_set_get_array_as_object( 'accept_language', @_ ) ); } |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
# NOTE: request parameter |
325
|
0
|
|
|
0
|
1
|
|
sub local_address { return( shift->_set_get_scalar( 'local_host', @_ ) ); } |
326
|
|
|
|
|
|
|
|
327
|
0
|
|
|
0
|
1
|
|
sub local_host { return( shift->_set_get_scalar( 'local_host', @_ ) ); } |
328
|
|
|
|
|
|
|
|
329
|
0
|
|
|
0
|
1
|
|
sub local_port { return( shift->_set_get_scalar( 'local_port', @_ ) ); } |
330
|
|
|
|
|
|
|
|
331
|
0
|
|
|
0
|
1
|
|
sub max_body_in_memory_size { return( shift->_set_get_number( 'max_body_in_memory_size', @_ ) ); } |
332
|
|
|
|
|
|
|
|
333
|
0
|
|
|
0
|
1
|
|
sub max_headers_size { return( shift->_set_get_number( 'max_headers_size', @_ ) ); } |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# NOTE: request parameter |
336
|
0
|
|
|
0
|
1
|
|
sub max_redirect { return( shift->_set_get_number( 'max_redirect', @_ ) ); } |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
# NOTE: request parameter |
339
|
0
|
|
|
0
|
1
|
|
sub max_size { return( shift->_set_get_number( 'max_size', @_ ) ); } |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# NOTE: medium method for Promise::Me |
342
|
0
|
|
|
0
|
1
|
|
sub medium { return( shift->_set_get_scalar( 'medium', @_ ) ); } |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
# TODO: mirror |
345
|
|
|
|
|
|
|
sub mirror |
346
|
|
|
|
|
|
|
{ |
347
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
348
|
0
|
|
|
|
|
|
my( $url, $file ) = @_; |
349
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
350
|
|
|
|
|
|
|
{ |
351
|
|
|
|
|
|
|
return( Promise::Me->new(sub |
352
|
|
|
|
|
|
|
{ |
353
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
354
|
0
|
0
|
0
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
355
|
|
|
|
|
|
|
code => 500, |
356
|
|
|
|
|
|
|
message => 'Local file name is missing', |
357
|
|
|
|
|
|
|
}) ) ) unless( defined( $file ) && length( $file ) ); |
358
|
|
|
|
|
|
|
|
359
|
0
|
|
0
|
|
|
|
my $request = HTTP::Promise::Request->new( 'GET' => $url ) || |
360
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
361
|
|
|
|
|
|
|
code => 500, |
362
|
|
|
|
|
|
|
message => HTTP::Promise::Request->error->message |
363
|
|
|
|
|
|
|
}) ) ); |
364
|
0
|
0
|
|
|
|
|
$self->prepare_headers( $request ) || |
365
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
366
|
|
|
|
|
|
|
code => 500, |
367
|
|
|
|
|
|
|
message => $self->error->message, |
368
|
|
|
|
|
|
|
}) ) ); |
369
|
0
|
|
0
|
|
|
|
$file = $self->new_file( $file ) || |
370
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
371
|
|
|
|
|
|
|
code => 500, |
372
|
|
|
|
|
|
|
message => $self->error->message, |
373
|
|
|
|
|
|
|
}) ) ); |
374
|
|
|
|
|
|
|
# If the file exists, add a cache-related header |
375
|
0
|
0
|
|
|
|
|
if( $file->exists ) |
376
|
|
|
|
|
|
|
{ |
377
|
|
|
|
|
|
|
# Module::Generic::Finfo->mtime returns a Module::Generic::DateTime object |
378
|
0
|
|
|
|
|
|
my $mtime = $file->mtime; |
379
|
0
|
0
|
|
|
|
|
if( $mtime ) |
380
|
|
|
|
|
|
|
{ |
381
|
0
|
|
0
|
|
|
|
my $strtime = $self->_datetime( $mtime ) || |
382
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
383
|
|
|
|
|
|
|
code => 500, |
384
|
|
|
|
|
|
|
message => $self->error->message, |
385
|
|
|
|
|
|
|
}) ) ); |
386
|
0
|
|
|
|
|
|
$request->header( 'If-Modified-Since' => $strtime ); |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
0
|
|
|
|
|
|
my $tmpfile = $self->new_tempfile; |
391
|
0
|
0
|
|
|
|
|
$tmpfile->touch || return( $reject->( $tmpfile->error ) ); |
392
|
|
|
|
|
|
|
|
393
|
0
|
|
0
|
|
|
|
my $response = $self->send( $request ) || return( $reject->( $self->pass_error ) ); |
394
|
|
|
|
|
|
|
|
395
|
0
|
0
|
|
|
|
|
if( $response->header( 'X-Died' ) ) |
396
|
|
|
|
|
|
|
{ |
397
|
0
|
|
|
|
|
|
$tmpfile->unlink; |
398
|
0
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
399
|
|
|
|
|
|
|
code => 500, |
400
|
|
|
|
|
|
|
message => $response->header( 'X-Died' ), |
401
|
|
|
|
|
|
|
}) ) ); |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
# Only fetching a fresh copy of the file would be considered success. |
405
|
|
|
|
|
|
|
# If the file was not modified, "304" would returned, which |
406
|
|
|
|
|
|
|
# is considered by HTTP::Status to be a "redirect", /not/ "success" |
407
|
0
|
0
|
|
|
|
|
if( $response->is_success ) |
408
|
|
|
|
|
|
|
{ |
409
|
0
|
|
|
|
|
|
my $body = $response->entity->body; |
410
|
0
|
0
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
411
|
|
|
|
|
|
|
code => 500, |
412
|
|
|
|
|
|
|
message => "No body set for this HTTP message entity.", |
413
|
|
|
|
|
|
|
}) ) ) if( !$body ); |
414
|
0
|
0
|
0
|
|
|
|
my $io = $body->open( '<' ) || |
415
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
416
|
|
|
|
|
|
|
code => 500, |
417
|
|
|
|
|
|
|
message => "Unable to open HTTP message entity body: " . $body->error, |
418
|
|
|
|
|
|
|
}) ) ) if( !$body ); |
419
|
0
|
0
|
0
|
|
|
|
my $out = $tmpfile->open( '>', { autoflush => 1 } ) || |
420
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
421
|
|
|
|
|
|
|
code => 500, |
422
|
|
|
|
|
|
|
message => "Unable to open temporary file \"$tmpfile\" in write mode: " . $tmpfile->error, |
423
|
|
|
|
|
|
|
}) ) ) if( !$body ); |
424
|
0
|
|
|
|
|
|
while( $io->read( my $buff, 8192 ) ) |
425
|
|
|
|
|
|
|
{ |
426
|
0
|
0
|
0
|
|
|
|
$out->print( $buff ) || |
427
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
428
|
|
|
|
|
|
|
code => 500, |
429
|
|
|
|
|
|
|
message => "Unable to write to temporary file \"$tmpfile\": " . $out->error, |
430
|
|
|
|
|
|
|
}) ) ) if( !$body ); |
431
|
|
|
|
|
|
|
} |
432
|
0
|
|
|
|
|
|
$io->close; |
433
|
0
|
|
|
|
|
|
$out->close; |
434
|
0
|
0
|
|
|
|
|
my $stat = $tmpfile->stat or |
435
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
436
|
|
|
|
|
|
|
code => 500, |
437
|
|
|
|
|
|
|
message => "Could not stat tmpfile '$tmpfile': " . $tmpfile->error, |
438
|
|
|
|
|
|
|
}) ) ); |
439
|
0
|
|
|
|
|
|
my $file_length = $stat->size; |
440
|
0
|
|
|
|
|
|
my( $content_length ) = $response->header( 'Content-length' ); |
441
|
|
|
|
|
|
|
|
442
|
0
|
0
|
0
|
|
|
|
if( defined( $content_length ) and $file_length < $content_length ) |
|
|
0
|
0
|
|
|
|
|
443
|
|
|
|
|
|
|
{ |
444
|
0
|
|
|
|
|
|
$tmpfile->unlink; |
445
|
0
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
446
|
|
|
|
|
|
|
code => 500, |
447
|
|
|
|
|
|
|
message => "Transfer truncated: only $file_length out of $content_length bytes received", |
448
|
|
|
|
|
|
|
}) ) ); |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
elsif( defined( $content_length ) and $file_length > $content_length ) |
451
|
|
|
|
|
|
|
{ |
452
|
0
|
|
|
|
|
|
$tmpfile->unlink; |
453
|
0
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
454
|
|
|
|
|
|
|
code => 500, |
455
|
|
|
|
|
|
|
message => "Content-length mismatch: expected $content_length bytes, got $file_length", |
456
|
|
|
|
|
|
|
}) ) ); |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
# The file was the expected length. |
459
|
|
|
|
|
|
|
else |
460
|
|
|
|
|
|
|
{ |
461
|
|
|
|
|
|
|
# Replace the stale file with a fresh copy |
462
|
|
|
|
|
|
|
# File::Copy will attempt to do it atomically, |
463
|
|
|
|
|
|
|
# and fall back to a delete + copy if that fails. |
464
|
0
|
|
0
|
|
|
|
$file = $tmpfile->move( $file, overwrite => 1 ) || |
465
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
466
|
|
|
|
|
|
|
code => 500, |
467
|
|
|
|
|
|
|
message => "Cannot copy '$tmpfile' to '$file': $!", |
468
|
|
|
|
|
|
|
}) ) ); |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
# Set standard file permissions if umask is supported. |
471
|
|
|
|
|
|
|
# If not, leave what Module::Generic::File created in effect. |
472
|
0
|
0
|
|
|
|
|
if( defined( my $umask = umask() ) ) |
473
|
|
|
|
|
|
|
{ |
474
|
0
|
|
|
|
|
|
my $mode = 0666 &~ $umask; |
475
|
0
|
0
|
|
|
|
|
$file->chmod( $mode ) || |
476
|
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
477
|
|
|
|
|
|
|
code => 500, |
478
|
|
|
|
|
|
|
message => sprintf( "Cannot chmod %o '%s': %s", $mode, $file, $file->error ), |
479
|
|
|
|
|
|
|
}) ) ); |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# make sure the file has the same last modification time |
483
|
0
|
0
|
|
|
|
|
if( my $lm = $response->last_modified ) |
484
|
|
|
|
|
|
|
{ |
485
|
|
|
|
|
|
|
$file->utime( $lm, $lm ) || do |
486
|
0
|
0
|
|
|
|
|
{ |
487
|
0
|
0
|
|
|
|
|
warn( "Warning: cannot update modification time for file '$file': $!\n" ) if( $self->_warnings_is_enabled ); |
488
|
|
|
|
|
|
|
}; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
# The local copy is fresh enough, so just delete the temp file |
493
|
|
|
|
|
|
|
else |
494
|
|
|
|
|
|
|
{ |
495
|
0
|
|
|
|
|
|
$tmpfile->unlink; |
496
|
|
|
|
|
|
|
} |
497
|
0
|
|
|
|
|
|
return( $resolve->( $response ) ); |
498
|
0
|
0
|
|
|
|
|
}, { ( defined( $self->{serialiser} ) ? ( serialiser => $self->{serialiser} ) : () ) } ) ); |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
else |
501
|
|
|
|
|
|
|
{ |
502
|
0
|
0
|
0
|
|
|
|
return( $self->error({ |
503
|
|
|
|
|
|
|
code => 500, |
504
|
|
|
|
|
|
|
message => 'Local file name is missing', |
505
|
|
|
|
|
|
|
}) ) unless( defined( $file ) && length( $file ) ); |
506
|
|
|
|
|
|
|
|
507
|
0
|
|
0
|
|
|
|
my $request = HTTP::Promise::Request->new( 'GET' => $url ) || |
508
|
|
|
|
|
|
|
return( $self->error({ |
509
|
|
|
|
|
|
|
code => 500, |
510
|
|
|
|
|
|
|
message => HTTP::Promise::Request->error->message |
511
|
|
|
|
|
|
|
}) ); |
512
|
0
|
0
|
|
|
|
|
$self->prepare_headers( $request ) || return( $self->pass_error ); |
513
|
0
|
|
0
|
|
|
|
$file = $self->new_file( $file ) || return( $self->pass_error ); |
514
|
|
|
|
|
|
|
# If the file exists, add a cache-related header |
515
|
0
|
0
|
|
|
|
|
if( $file->exists ) |
516
|
|
|
|
|
|
|
{ |
517
|
|
|
|
|
|
|
# Module::Generic::Finfo->mtime returns a Module::Generic::DateTime object |
518
|
0
|
|
|
|
|
|
my $mtime = $file->mtime; |
519
|
0
|
0
|
|
|
|
|
if( $mtime ) |
520
|
|
|
|
|
|
|
{ |
521
|
0
|
|
0
|
|
|
|
my $strtime = $self->_datetime( $mtime ) || |
522
|
|
|
|
|
|
|
return( $self->pass_error ); |
523
|
0
|
|
|
|
|
|
$request->header( 'If-Modified-Since' => $strtime ); |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
0
|
|
|
|
|
|
my $tmpfile = $self->new_tempfile; |
528
|
0
|
0
|
|
|
|
|
$tmpfile->touch || return( $self->pass_error( $tmpfile->error ) ); |
529
|
|
|
|
|
|
|
|
530
|
0
|
|
0
|
|
|
|
my $response = $self->send( $request ) || return( $self->pass_error ); |
531
|
|
|
|
|
|
|
|
532
|
0
|
0
|
|
|
|
|
if( $response->header( 'X-Died' ) ) |
533
|
|
|
|
|
|
|
{ |
534
|
0
|
|
|
|
|
|
$tmpfile->unlink; |
535
|
0
|
|
|
|
|
|
return( $self->error({ |
536
|
|
|
|
|
|
|
code => 500, |
537
|
|
|
|
|
|
|
message => $response->header( 'X-Died' ), |
538
|
|
|
|
|
|
|
}) ); |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# Only fetching a fresh copy of the file would be considered success. |
542
|
|
|
|
|
|
|
# If the file was not modified, "304" would returned, which |
543
|
|
|
|
|
|
|
# is considered by HTTP::Status to be a "redirect", /not/ "success" |
544
|
0
|
0
|
|
|
|
|
if( $response->is_success ) |
545
|
|
|
|
|
|
|
{ |
546
|
0
|
|
|
|
|
|
my $body = $response->entity->body; |
547
|
0
|
0
|
|
|
|
|
return( $self->error({ |
548
|
|
|
|
|
|
|
code => 500, |
549
|
|
|
|
|
|
|
message => "No body set for this HTTP message entity.", |
550
|
|
|
|
|
|
|
}) ) if( !$body ); |
551
|
0
|
0
|
0
|
|
|
|
my $io = $body->open( '<' ) || |
552
|
|
|
|
|
|
|
return( $self->error({ |
553
|
|
|
|
|
|
|
code => 500, |
554
|
|
|
|
|
|
|
message => "Unable to open HTTP message entity body: " . $body->error, |
555
|
|
|
|
|
|
|
}) ) if( !$body ); |
556
|
0
|
0
|
0
|
|
|
|
my $out = $tmpfile->open( '>', { autoflush => 1 } ) || |
557
|
|
|
|
|
|
|
return( $self->error({ |
558
|
|
|
|
|
|
|
code => 500, |
559
|
|
|
|
|
|
|
message => "Unable to open temporary file \"$tmpfile\" in write mode: " . $tmpfile->error, |
560
|
|
|
|
|
|
|
}) ) if( !$body ); |
561
|
0
|
|
|
|
|
|
while( $io->read( my $buff, 8192 ) ) |
562
|
|
|
|
|
|
|
{ |
563
|
0
|
0
|
0
|
|
|
|
$out->print( $buff ) || |
564
|
|
|
|
|
|
|
return( $self->error({ |
565
|
|
|
|
|
|
|
code => 500, |
566
|
|
|
|
|
|
|
message => "Unable to write to temporary file \"$tmpfile\": " . $out->error, |
567
|
|
|
|
|
|
|
}) ) if( !$body ); |
568
|
|
|
|
|
|
|
} |
569
|
0
|
|
|
|
|
|
$io->close; |
570
|
0
|
|
|
|
|
|
$out->close; |
571
|
0
|
0
|
|
|
|
|
my $stat = $tmpfile->stat or |
572
|
|
|
|
|
|
|
return( $self->error({ |
573
|
|
|
|
|
|
|
code => 500, |
574
|
|
|
|
|
|
|
message => "Could not stat tmpfile '$tmpfile': " . $tmpfile->error, |
575
|
|
|
|
|
|
|
}) ); |
576
|
0
|
|
|
|
|
|
my $file_length = $stat->size; |
577
|
0
|
|
|
|
|
|
my( $content_length ) = $response->header( 'Content-length' ); |
578
|
|
|
|
|
|
|
|
579
|
0
|
0
|
0
|
|
|
|
if( defined( $content_length ) and $file_length < $content_length ) |
|
|
0
|
0
|
|
|
|
|
580
|
|
|
|
|
|
|
{ |
581
|
0
|
|
|
|
|
|
$tmpfile->unlink; |
582
|
0
|
|
|
|
|
|
return( $self->error({ |
583
|
|
|
|
|
|
|
code => 500, |
584
|
|
|
|
|
|
|
message => "Transfer truncated: only $file_length out of $content_length bytes received", |
585
|
|
|
|
|
|
|
}) ); |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
elsif( defined( $content_length ) and $file_length > $content_length ) |
588
|
|
|
|
|
|
|
{ |
589
|
0
|
|
|
|
|
|
$tmpfile->unlink; |
590
|
0
|
|
|
|
|
|
return( $self->error({ |
591
|
|
|
|
|
|
|
code => 500, |
592
|
|
|
|
|
|
|
message => "Content-length mismatch: expected $content_length bytes, got $file_length", |
593
|
|
|
|
|
|
|
}) ); |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
# The file was the expected length. |
596
|
|
|
|
|
|
|
else |
597
|
|
|
|
|
|
|
{ |
598
|
|
|
|
|
|
|
# Replace the stale file with a fresh copy |
599
|
|
|
|
|
|
|
# File::Copy will attempt to do it atomically, |
600
|
|
|
|
|
|
|
# and fall back to a delete + copy if that fails. |
601
|
0
|
|
0
|
|
|
|
$file = $tmpfile->move( $file, overwrite => 1 ) || |
602
|
|
|
|
|
|
|
return( $self->error({ |
603
|
|
|
|
|
|
|
code => 500, |
604
|
|
|
|
|
|
|
message => "Cannot copy '$tmpfile' to '$file': $!", |
605
|
|
|
|
|
|
|
}) ); |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
# Set standard file permissions if umask is supported. |
608
|
|
|
|
|
|
|
# If not, leave what Module::Generic::File created in effect. |
609
|
0
|
0
|
|
|
|
|
if( defined( my $umask = umask() ) ) |
610
|
|
|
|
|
|
|
{ |
611
|
0
|
|
|
|
|
|
my $mode = 0666 &~ $umask; |
612
|
0
|
0
|
|
|
|
|
$file->chmod( $mode ) || |
613
|
|
|
|
|
|
|
return( $self->error({ |
614
|
|
|
|
|
|
|
code => 500, |
615
|
|
|
|
|
|
|
message => sprintf( "Cannot chmod %o '%s': %s", $mode, $file, $file->error ), |
616
|
|
|
|
|
|
|
}) ); |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
# make sure the file has the same last modification time |
620
|
0
|
0
|
|
|
|
|
if( my $lm = $response->last_modified ) |
621
|
|
|
|
|
|
|
{ |
622
|
|
|
|
|
|
|
$file->utime( $lm, $lm ) || do |
623
|
0
|
0
|
|
|
|
|
{ |
624
|
0
|
0
|
|
|
|
|
warn( "Warning: cannot update modification time for file '$file': $!\n" ) if( $self->_warnings_is_enabled ); |
625
|
|
|
|
|
|
|
}; |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
# The local copy is fresh enough, so just delete the temp file |
630
|
|
|
|
|
|
|
else |
631
|
|
|
|
|
|
|
{ |
632
|
0
|
|
|
|
|
|
$tmpfile->unlink; |
633
|
|
|
|
|
|
|
} |
634
|
0
|
|
|
|
|
|
return( $response ); |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
sub new_headers |
639
|
|
|
|
|
|
|
{ |
640
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
641
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::Headers' ) || return( $self->pass_error ); |
642
|
0
|
|
0
|
|
|
|
my $headers = HTTP::Promise::Headers->new( @_ ) || |
643
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Headers->error ) ); |
644
|
0
|
|
|
|
|
|
return( $headers ); |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
# NOTE: request parameter |
648
|
0
|
|
|
0
|
1
|
|
sub no_proxy { return( shift->_set_get_array_as_object( 'no_proxy', @_ ) ); } |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
sub options |
651
|
|
|
|
|
|
|
{ |
652
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
653
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
654
|
|
|
|
|
|
|
{ |
655
|
|
|
|
|
|
|
my $prom = Promise::Me->new(sub |
656
|
|
|
|
|
|
|
{ |
657
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
658
|
0
|
|
|
|
|
|
my $req = $self->_make_request_data( OPTIONS => @_ ) || |
659
|
|
|
|
|
|
|
die( HTTP::Promise::Request->error ); |
660
|
0
|
|
|
|
|
|
my $resp = $self->send( $req ) || return( $reject->( $self->error ) ); |
661
|
0
|
|
|
|
|
|
return( $resolve->( $resp ) ); |
662
|
|
|
|
|
|
|
}, |
663
|
|
|
|
|
|
|
{ |
664
|
|
|
|
|
|
|
args => [@_], |
665
|
|
|
|
|
|
|
( defined( $self->{serialiser} ) ? ( serialiser => $self->{serialiser} ) : () ), |
666
|
|
|
|
|
|
|
( defined( $self->{medium} ) ? ( medium => $self->{medium} ) : () ), |
667
|
0
|
|
0
|
|
|
|
( defined( $self->{shared_mem_size} ) ? ( result_shared_mem_size => $self->{shared_mem_size} ) : () ), |
668
|
|
|
|
|
|
|
}) || return( $self->pass_error( Promise::Me->error ) ); |
669
|
0
|
|
|
|
|
|
return( $prom ); |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
else |
672
|
|
|
|
|
|
|
{ |
673
|
0
|
|
0
|
|
|
|
my $req = $self->_make_request_data( OPTIONS => @_ ) || |
674
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Request->error ) ); |
675
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req ) || |
676
|
|
|
|
|
|
|
return( $self->pass_error ); |
677
|
0
|
|
|
|
|
|
return( $resp ); |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
sub patch |
682
|
|
|
|
|
|
|
{ |
683
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
684
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
685
|
|
|
|
|
|
|
{ |
686
|
|
|
|
|
|
|
my $prom = Promise::Me->new(sub |
687
|
|
|
|
|
|
|
{ |
688
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
689
|
0
|
|
|
|
|
|
my $req = $self->_make_request_data( PATCH => @_ ) || |
690
|
|
|
|
|
|
|
die( HTTP::Promise::Request->error ); |
691
|
0
|
|
|
|
|
|
my $resp = $self->send( $req ) || return( $reject->( $self->error ) ); |
692
|
0
|
|
|
|
|
|
return( $resolve->( $resp ) ); |
693
|
|
|
|
|
|
|
}, |
694
|
|
|
|
|
|
|
{ |
695
|
|
|
|
|
|
|
args => [@_], |
696
|
|
|
|
|
|
|
( defined( $self->{serialiser} ) ? ( serialiser => $self->{serialiser} ) : () ), |
697
|
|
|
|
|
|
|
( defined( $self->{medium} ) ? ( medium => $self->{medium} ) : () ), |
698
|
0
|
|
0
|
|
|
|
( defined( $self->{shared_mem_size} ) ? ( result_shared_mem_size => $self->{shared_mem_size} ) : () ), |
699
|
|
|
|
|
|
|
}) || return( $self->pass_error( Promise::Me->error ) ); |
700
|
0
|
|
|
|
|
|
return( $prom ); |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
else |
703
|
|
|
|
|
|
|
{ |
704
|
0
|
|
0
|
|
|
|
my $req = $self->_make_request_data( PATCH => @_ ) || |
705
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Request->error ) ); |
706
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req ) || |
707
|
|
|
|
|
|
|
return( $self->pass_error ); |
708
|
0
|
|
|
|
|
|
return( $resp ); |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
sub post |
713
|
|
|
|
|
|
|
{ |
714
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
715
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
716
|
|
|
|
|
|
|
{ |
717
|
|
|
|
|
|
|
my $prom = Promise::Me->new(sub |
718
|
|
|
|
|
|
|
{ |
719
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
720
|
0
|
|
|
|
|
|
my $req = $self->_make_request_data( POST => @_ ) || |
721
|
|
|
|
|
|
|
die( HTTP::Promise::Request->error ); |
722
|
0
|
|
|
|
|
|
my $resp = $self->send( $req ) || return( $reject->( $self->error ) ); |
723
|
0
|
|
|
|
|
|
return( $resolve->( $resp ) ); |
724
|
|
|
|
|
|
|
}, |
725
|
|
|
|
|
|
|
{ |
726
|
|
|
|
|
|
|
args => [@_], |
727
|
|
|
|
|
|
|
( defined( $self->{serialiser} ) ? ( serialiser => $self->{serialiser} ) : () ), |
728
|
|
|
|
|
|
|
( defined( $self->{medium} ) ? ( medium => $self->{medium} ) : () ), |
729
|
0
|
|
0
|
|
|
|
( defined( $self->{shared_mem_size} ) ? ( result_shared_mem_size => $self->{shared_mem_size} ) : () ), |
730
|
|
|
|
|
|
|
}) || return( $self->pass_error( Promise::Me->error ) ); |
731
|
0
|
|
|
|
|
|
return( $prom ); |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
else |
734
|
|
|
|
|
|
|
{ |
735
|
0
|
|
0
|
|
|
|
my $req = $self->_make_request_data( POST => @_ ) || |
736
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Request->error ) ); |
737
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req ) || |
738
|
|
|
|
|
|
|
return( $self->pass_error ); |
739
|
0
|
|
|
|
|
|
return( $resp ); |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
sub prepare_headers |
744
|
|
|
|
|
|
|
{ |
745
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
746
|
0
|
|
|
|
|
|
my $req = shift( @_ ); |
747
|
0
|
0
|
|
|
|
|
return( $self->error( "Object provided is not an HTTP::Promise::Request object" ) ) if( !$self->_is_a( $req => 'HTTP::Promise::Request' ) ); |
748
|
0
|
|
|
|
|
|
my $h = $req->headers; |
749
|
0
|
0
|
|
|
|
|
return( $self->error( "Request object provided does not have an HTTP::Promise::Headers object set to it!" ) ) if( !$h ); |
750
|
0
|
0
|
|
|
|
|
unless( $req->protocol ) |
751
|
|
|
|
|
|
|
{ |
752
|
0
|
|
0
|
|
|
|
$req->protocol( $self->default_protocol || 'HTTP/1.1' ); |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
# Set default headers now |
756
|
0
|
|
|
|
|
|
my $default_headers = $self->default_headers; |
757
|
|
|
|
|
|
|
$default_headers->scan(sub |
758
|
|
|
|
|
|
|
{ |
759
|
0
|
|
|
0
|
|
|
my( $name, $value ) = @_; |
760
|
0
|
|
|
|
|
|
$h->header( $name => $value ); |
761
|
0
|
|
|
|
|
|
}); |
762
|
|
|
|
|
|
|
|
763
|
0
|
|
|
|
|
|
my $ua = $self->agent; |
764
|
0
|
0
|
0
|
|
|
|
if( defined( $ua ) && !$h->user_agent ) |
765
|
|
|
|
|
|
|
{ |
766
|
0
|
|
|
|
|
|
$h->user_agent( $ua ); |
767
|
|
|
|
|
|
|
} |
768
|
|
|
|
|
|
|
# e.g.: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8 |
769
|
0
|
0
|
|
|
|
|
if( !$h->accept ) |
770
|
|
|
|
|
|
|
{ |
771
|
0
|
|
|
|
|
|
$h->accept( 'text/html,application/xhtml+xml;q=0.9,*/*;q=0.8' ); |
772
|
|
|
|
|
|
|
} |
773
|
|
|
|
|
|
|
# Accept-Encoding: gzip, deflate, br |
774
|
0
|
|
|
|
|
|
my $ae = $self->accept_encoding; |
775
|
0
|
0
|
0
|
|
|
|
if( !$h->accept_encoding && $ae ne 'none' ) |
776
|
|
|
|
|
|
|
{ |
777
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::Stream' ) || return( $self->pass_error ); |
778
|
0
|
|
|
|
|
|
my $decodables; |
779
|
0
|
0
|
0
|
|
|
|
if( !$ae->is_empty && $ae ne 'all' && $ae ne 'auto' ) |
|
|
|
0
|
|
|
|
|
780
|
|
|
|
|
|
|
{ |
781
|
0
|
|
|
|
|
|
$decodables = HTTP::Promise::Stream->decodable( [split( /[[:blank:]\h]*\,[[:blank:]\h]*/, "$ae" )] ); |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
else |
784
|
|
|
|
|
|
|
{ |
785
|
0
|
|
|
|
|
|
$decodables = HTTP::Promise::Stream->decodable( 'browser' ); |
786
|
|
|
|
|
|
|
} |
787
|
0
|
|
|
|
|
|
$h->accept_encoding( $decodables->join( ',' )->scalar ); |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
# Accept-Language: fr-FR,en-GB;q=0.8,fr;q=0.6,en;q=0.4,ja;q=0.2 |
790
|
0
|
0
|
0
|
|
|
|
if( !$h->accept_language && !$self->accept_language->is_empty ) |
791
|
|
|
|
|
|
|
{ |
792
|
0
|
|
|
|
|
|
my $pref = 0.9; |
793
|
0
|
|
|
|
|
|
my $langs = []; |
794
|
|
|
|
|
|
|
$self->accept_language->foreach(sub |
795
|
|
|
|
|
|
|
{ |
796
|
0
|
|
|
0
|
|
|
push( @$langs, sprintf( '%s;q=%.1f', $_, $pref ) ); |
797
|
0
|
0
|
|
|
|
|
$pref -= 0.1 unless( $pref == 0.1 ); |
798
|
0
|
|
|
|
|
|
}); |
799
|
0
|
|
|
|
|
|
$h->accept_language( join( ',', @$langs ) ); |
800
|
|
|
|
|
|
|
} |
801
|
0
|
|
|
|
|
|
my $dnt = $self->dnt; |
802
|
0
|
0
|
0
|
|
|
|
if( !defined( $h->dnt ) && defined( $dnt ) ) |
803
|
|
|
|
|
|
|
{ |
804
|
0
|
0
|
|
|
|
|
$h->dnt( $dnt ? 1 : 0 ); |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
# Upgrade-Insecure-Requests: 1 |
807
|
0
|
|
|
|
|
|
my $upgrade_ssl = $self->auto_switch_https; |
808
|
0
|
0
|
0
|
|
|
|
if( $req->uri->scheme eq 'http' && ( !defined( $upgrade_ssl ) || $upgrade_ssl ) ) |
|
|
|
0
|
|
|
|
|
809
|
|
|
|
|
|
|
{ |
810
|
0
|
|
|
|
|
|
$h->upgrade_insecure_requests(1); |
811
|
|
|
|
|
|
|
} |
812
|
0
|
|
|
|
|
|
return( $req ); |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
|
815
|
0
|
|
|
0
|
1
|
|
sub proxy { return( shift->_set_get_scalar_as_object( 'proxy', @_ ) ); } |
816
|
|
|
|
|
|
|
|
817
|
0
|
|
|
0
|
1
|
|
sub proxy_authorization { return( shift->_set_get_scalar_as_object( 'proxy_authorization', @_ ) ); } |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
sub put |
820
|
|
|
|
|
|
|
{ |
821
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
822
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
823
|
|
|
|
|
|
|
{ |
824
|
|
|
|
|
|
|
my $prom = Promise::Me->new(sub |
825
|
|
|
|
|
|
|
{ |
826
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
827
|
0
|
|
|
|
|
|
my $req = $self->_make_request_data( PUT => @_ ) || |
828
|
|
|
|
|
|
|
die( HTTP::Promise::Request->error ); |
829
|
0
|
|
|
|
|
|
my $resp = $self->send( $req ) || return( $reject->( $self->error ) ); |
830
|
0
|
|
|
|
|
|
return( $resolve->( $resp ) ); |
831
|
|
|
|
|
|
|
}, |
832
|
|
|
|
|
|
|
{ |
833
|
|
|
|
|
|
|
args => [@_], |
834
|
|
|
|
|
|
|
( defined( $self->{serialiser} ) ? ( serialiser => $self->{serialiser} ) : () ), |
835
|
|
|
|
|
|
|
( defined( $self->{medium} ) ? ( medium => $self->{medium} ) : () ), |
836
|
0
|
|
0
|
|
|
|
( defined( $self->{shared_mem_size} ) ? ( result_shared_mem_size => $self->{shared_mem_size} ) : () ), |
837
|
|
|
|
|
|
|
}) || return( $self->pass_error( Promise::Me->error ) ); |
838
|
0
|
|
|
|
|
|
return( $prom ); |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
else |
841
|
|
|
|
|
|
|
{ |
842
|
0
|
|
0
|
|
|
|
my $req = $self->_make_request_data( PUT => @_ ) || |
843
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Request->error ) ); |
844
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req ) || |
845
|
|
|
|
|
|
|
return( $self->pass_error ); |
846
|
0
|
|
|
|
|
|
return( $resp ); |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
sub request |
851
|
|
|
|
|
|
|
{ |
852
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
853
|
0
|
|
|
|
|
|
my $req = shift( @_ ); |
854
|
0
|
|
|
|
|
|
my $opts = $self->_get_args_as_hash( @_ ); |
855
|
0
|
|
0
|
|
|
|
$opts->{read_size} //= 0; |
856
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
857
|
|
|
|
|
|
|
{ |
858
|
|
|
|
|
|
|
my $prom = Promise::Me->new(sub |
859
|
|
|
|
|
|
|
{ |
860
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
861
|
0
|
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
862
|
|
|
|
|
|
|
code => 500, |
863
|
|
|
|
|
|
|
message => "No request object was provided." |
864
|
|
|
|
|
|
|
}) ) ) if( !$req ); |
865
|
0
|
|
|
|
|
|
$self->use_content_file( $opts->{use_content_file} ) if( exists( $opts->{use_content_file} ) ); |
866
|
0
|
|
|
|
|
|
my $resp = $self->send( $req, $opts ) || return( $reject->( $self->pass_error ) ); |
867
|
0
|
|
|
|
|
|
return( $resolve->( $resp ) ); |
868
|
|
|
|
|
|
|
}, |
869
|
|
|
|
|
|
|
{ |
870
|
|
|
|
|
|
|
( defined( $self->{serialiser} ) ? ( serialiser => $self->{serialiser} ) : () ), |
871
|
|
|
|
|
|
|
( defined( $self->{medium} ) ? ( medium => $self->{medium} ) : () ), |
872
|
0
|
|
0
|
|
|
|
( defined( $self->{shared_mem_size} ) ? ( result_shared_mem_size => $self->{shared_mem_size} ) : () ), |
873
|
|
|
|
|
|
|
}) || return( $self->pass_error( Promise::Me->error ) ); |
874
|
0
|
|
|
|
|
|
return( $prom ); |
875
|
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
|
else |
877
|
|
|
|
|
|
|
{ |
878
|
0
|
0
|
|
|
|
|
return( $self->error( "No request object was provided." ) ) if( !$req ); |
879
|
0
|
0
|
|
|
|
|
$self->use_content_file( $opts->{use_content_file} ) if( exists( $opts->{use_content_file} ) ); |
880
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req, $opts ) || return( $self->pass_error ); |
881
|
0
|
|
|
|
|
|
return( $resp ); |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
} |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
# NOTE: request parameter |
886
|
0
|
|
|
0
|
1
|
|
sub requests_redirectable { return( shift->_set_get_array_as_object( 'requests_redirectable', @_ ) ); } |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
sub send |
889
|
|
|
|
|
|
|
{ |
890
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
891
|
0
|
|
|
|
|
|
my $req = shift( @_ ); |
892
|
0
|
0
|
|
|
|
|
return( $self->error( "Request object provided ($req) is not a HTTP::Promise::Request object." ) ) if( !$self->_is_a( $req => 'HTTP::Promise::Request' ) ); |
893
|
0
|
|
|
|
|
|
my $opts = $self->_get_args_as_hash( @_ ); |
894
|
0
|
|
0
|
|
|
|
$opts->{expect_threshold} //= $self->expect_threshold // 0; |
|
|
|
0
|
|
|
|
|
895
|
0
|
|
0
|
|
|
|
$opts->{total_attempts} //= 0; |
896
|
0
|
|
|
|
|
|
my $p = {}; |
897
|
|
|
|
|
|
|
# my $timeout = time() + $self->timeout; |
898
|
0
|
|
|
|
|
|
my $timeout = $self->timeout; |
899
|
0
|
|
|
|
|
|
my $uri = $req->uri; |
900
|
|
|
|
|
|
|
# my ($scheme, $username, $password, $host, $port, $path_query); |
901
|
0
|
0
|
0
|
|
|
|
if( !$uri->scheme ) |
|
|
0
|
|
|
|
|
|
902
|
|
|
|
|
|
|
{ |
903
|
0
|
|
|
|
|
|
$uri->scheme( 'http' ); |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
elsif( $uri->scheme ne 'http' && $uri->scheme ne 'https' ) |
906
|
|
|
|
|
|
|
{ |
907
|
0
|
|
|
|
|
|
return( $self->error( "Unsupported scheme: ", $uri->scheme ) ); |
908
|
|
|
|
|
|
|
} |
909
|
0
|
0
|
|
|
|
|
my $default_port = $uri->scheme eq 'http' |
910
|
|
|
|
|
|
|
? 80 |
911
|
|
|
|
|
|
|
: 443; |
912
|
0
|
0
|
0
|
|
|
|
if( !$uri->can( 'port' ) || !defined( $uri->port ) || !length( $uri->port ) ) |
913
|
|
|
|
|
|
|
{ |
914
|
0
|
|
|
|
|
|
$p->{port} = $default_port; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
else |
917
|
|
|
|
|
|
|
{ |
918
|
0
|
|
|
|
|
|
$p->{port} = $uri->port; |
919
|
|
|
|
|
|
|
} |
920
|
0
|
0
|
|
|
|
|
$uri->path( '/' ) if( !length( $uri->path ) ); |
921
|
|
|
|
|
|
|
|
922
|
0
|
|
0
|
|
|
|
$p->{host} = $uri->host || |
923
|
|
|
|
|
|
|
return( $self->error( "No host set for request uri \"$uri\"." ) ); |
924
|
|
|
|
|
|
|
|
925
|
0
|
0
|
|
|
|
|
if( my $local_host = $self->local_host ) |
926
|
|
|
|
|
|
|
{ |
927
|
0
|
|
|
|
|
|
$p->{local_host} = $local_host; |
928
|
|
|
|
|
|
|
} |
929
|
0
|
0
|
|
|
|
|
if( my $local_port = $self->local_port ) |
930
|
|
|
|
|
|
|
{ |
931
|
0
|
|
|
|
|
|
$p->{local_port} = $local_port; |
932
|
|
|
|
|
|
|
} |
933
|
|
|
|
|
|
|
|
934
|
0
|
|
|
|
|
|
my $proxy = $self->proxy; |
935
|
0
|
|
|
|
|
|
my $no_proxy = $self->no_proxy; |
936
|
0
|
0
|
0
|
|
|
|
if( $proxy && $no_proxy ) |
937
|
|
|
|
|
|
|
{ |
938
|
0
|
0
|
|
|
|
|
if( $self->_match_no_proxy( $no_proxy, $p->{host} ) ) |
939
|
|
|
|
|
|
|
{ |
940
|
0
|
|
|
|
|
|
undef( $proxy ); |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
|
944
|
0
|
|
|
|
|
|
local $SIG{PIPE} = 'IGNORE'; |
945
|
0
|
|
|
|
|
|
my $io; |
946
|
0
|
|
|
|
|
|
my $sock = $self->_pool->steal( @$p{qw( host port )} ); |
947
|
0
|
0
|
0
|
|
|
|
if( defined( $sock ) && Scalar::Util::openhandle( $sock ) ) |
948
|
|
|
|
|
|
|
{ |
949
|
0
|
|
0
|
|
|
|
$io = HTTP::Promise::IO->new( $sock, stop_if => $self->stop_if ) || |
950
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::IO->error ) ); |
951
|
0
|
0
|
|
|
|
|
if( $io->make_select( write => 0, timeout => 0 ) ) |
952
|
|
|
|
|
|
|
{ |
953
|
0
|
|
|
|
|
|
close( $sock ); |
954
|
0
|
|
|
|
|
|
undef( $sock ); |
955
|
|
|
|
|
|
|
} |
956
|
|
|
|
|
|
|
else |
957
|
|
|
|
|
|
|
{ |
958
|
0
|
|
|
|
|
|
$p->{in_keepalive} = 1; |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
} |
961
|
0
|
0
|
|
|
|
|
if( !$p->{in_keepalive} ) |
962
|
|
|
|
|
|
|
{ |
963
|
0
|
0
|
|
|
|
|
if( $proxy ) |
964
|
|
|
|
|
|
|
{ |
965
|
|
|
|
|
|
|
# my( undef, $proxy_user, $proxy_pass, $proxy_host, $proxy_port, undef) = $self->_parse_url($proxy); |
966
|
0
|
0
|
|
|
|
|
return( $self->error( "Proxy set '$proxy' (", overload::StrVal( $proxy ), ") is not URI object." ) ) if( !$self->_is_a( $proxy => 'URI' ) ); |
967
|
0
|
|
|
|
|
|
my $proxy_auth = $proxy->userinfo; |
968
|
0
|
|
|
|
|
|
my( $proxy_user, $proxy_pass ) = split( /:/, $proxy_auth, 2 ); |
969
|
0
|
|
|
|
|
|
my $proxy_authorization; |
970
|
0
|
0
|
0
|
|
|
|
if( defined( $proxy_user ) && length( $proxy_user ) ) |
971
|
|
|
|
|
|
|
{ |
972
|
0
|
0
|
|
|
|
|
$self->_load_class( 'URI::Escape::XS' ) || return( $self->pass_error ); |
973
|
0
|
|
|
|
|
|
$p->{proxy_user} = URI::Escape::XS::uri_unescape( $proxy_user ); |
974
|
0
|
|
|
|
|
|
$p->{proxy_pass} = URI::Escape::XS::uri_unescape( $proxy_pass ); |
975
|
0
|
0
|
|
|
|
|
$self->_load_class( 'Crypt::Misc' ) || return( $self->pass_error ); |
976
|
0
|
|
|
|
|
|
$proxy_authorization = 'Basic ' . Crypt::Misc::encode_b64( join( ':', @$p{qw( proxy_user proxy_pass )} ), '' ); |
977
|
|
|
|
|
|
|
} |
978
|
0
|
0
|
|
|
|
|
if( $uri->scheme eq 'http' ) |
979
|
|
|
|
|
|
|
{ |
980
|
|
|
|
|
|
|
$io = HTTP::Promise::IO->connect( |
981
|
|
|
|
|
|
|
host => $proxy->host, |
982
|
|
|
|
|
|
|
port => $proxy->port, |
983
|
|
|
|
|
|
|
stop_if => $self->stop_if, |
984
|
|
|
|
|
|
|
timeout => $timeout, |
985
|
|
|
|
|
|
|
debug => $self->debug, |
986
|
|
|
|
|
|
|
( defined( $p->{local_host} ) ? ( local_host => $p->{local_host} ) : () ), |
987
|
0
|
|
0
|
|
|
|
( defined( $p->{local_port} ) ? ( local_port => $p->{local_port} ) : () ), |
988
|
|
|
|
|
|
|
) || return( HTTP::Promise::IO->pass_error ); |
989
|
0
|
0
|
|
|
|
|
if( defined( $proxy_authorization ) ) |
990
|
|
|
|
|
|
|
{ |
991
|
0
|
|
|
|
|
|
$self->proxy_authorization( $proxy_authorization ); |
992
|
|
|
|
|
|
|
} |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
else |
995
|
|
|
|
|
|
|
{ |
996
|
|
|
|
|
|
|
$io = HTTP::Promise::IO->connect_ssl_over_proxy( |
997
|
|
|
|
|
|
|
proxy_host => $proxy->host, |
998
|
|
|
|
|
|
|
proxy_port => $proxy->port, |
999
|
|
|
|
|
|
|
host => $p->{host}, |
1000
|
|
|
|
|
|
|
port => $p->{port}, |
1001
|
|
|
|
|
|
|
stop_if => $self->stop_if, |
1002
|
|
|
|
|
|
|
timeout => $timeout, |
1003
|
|
|
|
|
|
|
proxy_authorization => $proxy_authorization, |
1004
|
|
|
|
|
|
|
debug => $self->debug, |
1005
|
|
|
|
|
|
|
( defined( $p->{local_host} ) ? ( local_host => $p->{local_host} ) : () ), |
1006
|
0
|
|
0
|
|
|
|
( defined( $p->{local_port} ) ? ( local_port => $p->{local_port} ) : () ), |
1007
|
|
|
|
|
|
|
) || return( HTTP::Promise::IO->pass_error ); |
1008
|
|
|
|
|
|
|
} |
1009
|
|
|
|
|
|
|
} |
1010
|
|
|
|
|
|
|
else |
1011
|
|
|
|
|
|
|
{ |
1012
|
0
|
0
|
|
|
|
|
if( $uri->scheme eq 'http' ) |
1013
|
|
|
|
|
|
|
{ |
1014
|
|
|
|
|
|
|
$io = HTTP::Promise::IO->connect( |
1015
|
|
|
|
|
|
|
host => $uri->host, |
1016
|
|
|
|
|
|
|
port => $uri->port, |
1017
|
|
|
|
|
|
|
stop_if => $self->stop_if, |
1018
|
|
|
|
|
|
|
timeout => $timeout, |
1019
|
|
|
|
|
|
|
debug => $self->debug, |
1020
|
|
|
|
|
|
|
( defined( $p->{local_host} ) ? ( local_host => $p->{local_host} ) : () ), |
1021
|
0
|
|
0
|
|
|
|
( defined( $p->{local_port} ) ? ( local_port => $p->{local_port} ) : () ), |
1022
|
|
|
|
|
|
|
) || return( HTTP::Promise::IO->pass_error ); |
1023
|
|
|
|
|
|
|
} |
1024
|
|
|
|
|
|
|
else |
1025
|
|
|
|
|
|
|
{ |
1026
|
|
|
|
|
|
|
$io = HTTP::Promise::IO->connect_ssl( |
1027
|
|
|
|
|
|
|
host => $uri->host, |
1028
|
|
|
|
|
|
|
port => $uri->port, |
1029
|
|
|
|
|
|
|
stop_if => $self->stop_if, |
1030
|
|
|
|
|
|
|
timeout => $timeout, |
1031
|
|
|
|
|
|
|
debug => $self->debug, |
1032
|
|
|
|
|
|
|
( defined( $p->{local_host} ) ? ( local_host => $p->{local_host} ) : () ), |
1033
|
0
|
|
0
|
|
|
|
( defined( $p->{local_port} ) ? ( local_port => $p->{local_port} ) : () ), |
1034
|
|
|
|
|
|
|
) || return( HTTP::Promise::IO->pass_error ); |
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
} |
1037
|
|
|
|
|
|
|
# return( $self->pass_error ) unless( $io ); |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
0
|
|
|
|
|
|
my $total_bytes_sent = 0; |
1041
|
0
|
|
|
|
|
|
my $total_bytes_read = 0; |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
my $send_body = sub |
1044
|
|
|
|
|
|
|
{ |
1045
|
0
|
|
|
0
|
|
|
my $entity = shift( @_ ); |
1046
|
0
|
|
|
|
|
|
my $body = $entity->body; |
1047
|
0
|
|
|
|
|
|
my $body_len = $body->length; |
1048
|
0
|
|
|
|
|
|
my $ct_len = $req->headers->content_length; |
1049
|
0
|
0
|
|
|
|
|
if( $body_len != $ct_len ) |
1050
|
|
|
|
|
|
|
{ |
1051
|
0
|
0
|
|
|
|
|
warn( "Content-Length set (${ct_len}) does not match the actual body size (${body_len})\n" ) if( warnings::enabled( ref( $self ) ) ); |
1052
|
|
|
|
|
|
|
} |
1053
|
|
|
|
|
|
|
|
1054
|
0
|
|
|
|
|
|
my $sock = $io->filehandle; |
1055
|
0
|
|
|
|
|
|
my $bytes_sent = 0; |
1056
|
0
|
0
|
|
|
|
|
$entity->print_body( $io ) || return( $self->pass_error( $entity->error ) ); |
1057
|
|
|
|
|
|
|
# NOTE: Hmmmm, really not great, but otherwise I would need to change a lot of code |
1058
|
0
|
|
|
|
|
|
$bytes_sent = $body->length; |
1059
|
0
|
|
|
|
|
|
return( $bytes_sent ); |
1060
|
0
|
|
|
|
|
|
}; |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
# write request |
1063
|
|
|
|
|
|
|
# my $method = $req->method || 'GET'; |
1064
|
0
|
|
|
|
|
|
my $method = $req->method; |
1065
|
0
|
|
|
|
|
|
my $connection_header = $self->connection_header; |
1066
|
|
|
|
|
|
|
# If no connection_header value was provided, let's guess it based on the protocol used |
1067
|
0
|
0
|
|
|
|
|
unless( $connection_header ) |
1068
|
|
|
|
|
|
|
{ |
1069
|
0
|
0
|
0
|
|
|
|
if( uc( $method ) eq 'HEAD' ) |
|
|
0
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
{ |
1071
|
0
|
|
|
|
|
|
$connection_header = 'close'; |
1072
|
|
|
|
|
|
|
} |
1073
|
|
|
|
|
|
|
elsif( $req->version && $req->version > 1.0 ) |
1074
|
|
|
|
|
|
|
{ |
1075
|
0
|
|
|
|
|
|
$connection_header = 'keep-alive'; |
1076
|
|
|
|
|
|
|
} |
1077
|
|
|
|
|
|
|
else |
1078
|
|
|
|
|
|
|
{ |
1079
|
0
|
|
|
|
|
|
$connection_header = 'close'; |
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
} |
1082
|
|
|
|
|
|
|
|
1083
|
0
|
|
|
|
|
|
my $cookie_jar = $self->cookie_jar; |
1084
|
|
|
|
|
|
|
{ |
1085
|
0
|
|
|
|
|
|
my $headers = $req->headers; |
|
0
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
# Add headers that were provided as parameters |
1087
|
0
|
|
|
|
|
|
my $in_headers = $opts->{headers}; |
1088
|
0
|
0
|
|
|
|
|
if( $self->_is_array( $in_headers ) ) |
1089
|
|
|
|
|
|
|
{ |
1090
|
0
|
|
|
|
|
|
for( my $i = 0; $i < @$in_headers; $i += 2 ) |
1091
|
|
|
|
|
|
|
{ |
1092
|
0
|
|
|
|
|
|
my $name = $in_headers->[$i]; |
1093
|
0
|
0
|
|
|
|
|
if( lc( $name ) eq 'connection' ) |
1094
|
|
|
|
|
|
|
{ |
1095
|
0
|
|
|
|
|
|
$connection_header = $in_headers->[$i + 1]; |
1096
|
|
|
|
|
|
|
} |
1097
|
|
|
|
|
|
|
else |
1098
|
|
|
|
|
|
|
{ |
1099
|
0
|
|
|
|
|
|
$headers->push_header( $name => $in_headers->[$i + 1] ); |
1100
|
|
|
|
|
|
|
} |
1101
|
|
|
|
|
|
|
} |
1102
|
|
|
|
|
|
|
} |
1103
|
0
|
|
|
|
|
|
$headers->header( Connection => $connection_header ); |
1104
|
|
|
|
|
|
|
|
1105
|
0
|
0
|
|
|
|
|
if( my $pa = $self->proxy_authorization ) |
1106
|
|
|
|
|
|
|
{ |
1107
|
0
|
|
|
|
|
|
$headers->header( 'Proxy-Authorization' => $pa ); |
1108
|
|
|
|
|
|
|
} |
1109
|
0
|
|
|
|
|
|
my $userinfo = $uri->userinfo; |
1110
|
0
|
0
|
0
|
|
|
|
if( defined( $userinfo ) && length( $userinfo ) ) |
1111
|
|
|
|
|
|
|
{ |
1112
|
0
|
|
|
|
|
|
my( $username, $password ) = split( /:/, $userinfo, 2 ); |
1113
|
0
|
0
|
|
|
|
|
$self->_load_class( 'URI::Escape' ) || return( $self->pass_error ); |
1114
|
0
|
|
|
|
|
|
my $unescape_username = URI::Escape::uri_unescape( $username ); |
1115
|
0
|
|
|
|
|
|
my $unescape_password = URI::Escape::uri_unescape( $password ); |
1116
|
0
|
0
|
|
|
|
|
$self->_load_class( 'Crypt::Misc' ) || return( $self->pass_error ); |
1117
|
0
|
|
|
|
|
|
my $authorization = 'Basic ' . Crypt::Misc::encode_b64( "${unescape_username}:${unescape_password}" ); |
1118
|
0
|
|
|
|
|
|
$headers->header( Authorization => 'Basic ' . $authorization ); |
1119
|
|
|
|
|
|
|
} |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
# set Cookie header |
1122
|
0
|
0
|
|
|
|
|
if( defined( $cookie_jar ) ) |
1123
|
|
|
|
|
|
|
{ |
1124
|
0
|
0
|
|
|
|
|
$cookie_jar->add_request_header( $req ) || |
1125
|
|
|
|
|
|
|
return( $self->pass_error( $cookie_jar->error ) ); |
1126
|
|
|
|
|
|
|
} |
1127
|
|
|
|
|
|
|
|
1128
|
0
|
|
|
|
|
|
my $body = $req->entity->body; |
1129
|
0
|
0
|
0
|
|
|
|
if( defined( $body ) && $body ) |
1130
|
|
|
|
|
|
|
{ |
1131
|
0
|
0
|
0
|
|
|
|
if( $body->isa( 'HTTP::Promise::Body::Form' ) && |
|
|
|
0
|
|
|
|
|
1132
|
|
|
|
|
|
|
( !$headers->exists( 'Content-Type' ) || $headers->content_type->is_empty ) ) |
1133
|
|
|
|
|
|
|
{ |
1134
|
0
|
|
|
|
|
|
$headers->header( 'Content-Type' => 'application/x-www-form-urlencoded' ); |
1135
|
|
|
|
|
|
|
} |
1136
|
0
|
0
|
|
|
|
|
if( !$headers->exists( 'Content-Length' ) ) |
1137
|
|
|
|
|
|
|
{ |
1138
|
0
|
|
|
|
|
|
my $content_length = $body->length; |
1139
|
0
|
|
|
|
|
|
$headers->header( 'Content-Length' => "$content_length" ); |
1140
|
|
|
|
|
|
|
} |
1141
|
|
|
|
|
|
|
} |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
# finally, set Host header |
1144
|
0
|
0
|
|
|
|
|
my $request_target = ( $uri->port == $default_port ) ? $uri->host : $uri->host_port; |
1145
|
0
|
|
|
|
|
|
$headers->header( Host => $request_target ); |
1146
|
|
|
|
|
|
|
|
1147
|
0
|
|
0
|
|
|
|
my $expect_threshold = $opts->{expect_threshold} // $self->expect_threshold; |
1148
|
0
|
0
|
|
|
|
|
if( defined( $expect_threshold ) ) |
1149
|
|
|
|
|
|
|
{ |
1150
|
0
|
0
|
|
|
|
|
if( $self->_is_integer( $expect_threshold ) ) |
1151
|
|
|
|
|
|
|
{ |
1152
|
0
|
|
|
|
|
|
$expect_threshold += 0; |
1153
|
|
|
|
|
|
|
} |
1154
|
|
|
|
|
|
|
else |
1155
|
|
|
|
|
|
|
{ |
1156
|
0
|
|
|
|
|
|
undef( $expect_threshold ); |
1157
|
|
|
|
|
|
|
} |
1158
|
|
|
|
|
|
|
} |
1159
|
|
|
|
|
|
|
|
1160
|
0
|
0
|
0
|
|
|
|
if( $req->version && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1161
|
|
|
|
|
|
|
$req->version > 1.0 && |
1162
|
|
|
|
|
|
|
defined( $expect_threshold ) && |
1163
|
|
|
|
|
|
|
defined( $body ) && |
1164
|
|
|
|
|
|
|
$body->length > $expect_threshold ) |
1165
|
|
|
|
|
|
|
{ |
1166
|
0
|
|
|
|
|
|
$headers->expect( '100-Continue' ); |
1167
|
|
|
|
|
|
|
} |
1168
|
|
|
|
|
|
|
|
1169
|
0
|
|
|
|
|
|
my $request = $req->start_line . $CRLF . $req->headers->as_string; |
1170
|
0
|
|
|
|
|
|
$request .= $CRLF; |
1171
|
0
|
|
|
|
|
|
my $bytes = $io->write_all( $request, $timeout ); |
1172
|
0
|
0
|
|
|
|
|
if( !defined( $bytes ) ) |
|
|
0
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
{ |
1174
|
0
|
|
|
|
|
|
return( $self->pass_error( $io->error ) ); |
1175
|
|
|
|
|
|
|
} |
1176
|
|
|
|
|
|
|
# Could not transmit the headers |
1177
|
|
|
|
|
|
|
elsif( !$bytes ) |
1178
|
|
|
|
|
|
|
{ |
1179
|
0
|
|
|
|
|
|
return( $self->error({ code => 500, message => "Zero byte could actually be sent to the socket '", $io->filehandle, "'." }) ); |
1180
|
|
|
|
|
|
|
} |
1181
|
0
|
|
|
|
|
|
$total_bytes_sent = $bytes; |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
# If this is not an Expect query, we send the body now |
1184
|
|
|
|
|
|
|
# otherwise if this is an Expect type of query, we would read the response header |
1185
|
|
|
|
|
|
|
# and send the body |
1186
|
0
|
0
|
0
|
|
|
|
if( !$headers->expect && defined( $body ) && $body ) |
|
|
|
0
|
|
|
|
|
1187
|
|
|
|
|
|
|
{ |
1188
|
0
|
|
|
|
|
|
my $bytes = $send_body->( $req->entity ); |
1189
|
0
|
0
|
|
|
|
|
return( $self->pass_error ) if( !defined( $bytes ) ); |
1190
|
0
|
|
|
|
|
|
$total_bytes_sent += $bytes; |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
} |
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
# read response |
1195
|
0
|
|
|
|
|
|
my $buff = ''; |
1196
|
0
|
|
|
|
|
|
my $parser = HTTP::Promise::Parser->new; |
1197
|
0
|
|
|
|
|
|
my $bufsize = $self->buffer_size; |
1198
|
0
|
|
|
|
|
|
$io->max_read_buffer( $bufsize ); |
1199
|
0
|
|
|
|
|
|
$io->debug( $self->debug ); |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
# Maximum headers size is not oficial, but we definitely need to set some limit. |
1202
|
|
|
|
|
|
|
# <https://security.stackexchange.com/questions/110565/large-over-sizesd-http-header-lengths-and-security-implications> |
1203
|
0
|
|
|
|
|
|
my $max = $self->max_headers_size; |
1204
|
0
|
|
|
|
|
|
my( $n, $def, $headers ); |
1205
|
0
|
|
|
|
|
|
$n = -1; |
1206
|
0
|
|
|
|
|
|
LOOP: while(1) |
1207
|
|
|
|
|
|
|
{ |
1208
|
0
|
|
|
|
|
|
$n = $io->read( $buff, 2048, length( $buff ) ); |
1209
|
0
|
0
|
0
|
|
|
|
if( !defined( $n ) || $n == 0 ) |
1210
|
|
|
|
|
|
|
{ |
1211
|
0
|
0
|
|
|
|
|
my $code = defined( $n ) ? '' : $io->error->code; |
1212
|
0
|
0
|
0
|
|
|
|
if( $p->{in_keepalive} && |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1213
|
|
|
|
|
|
|
( length( $buff ) // 0 ) == 0 && |
1214
|
|
|
|
|
|
|
!$opts->{total_attempts} && |
1215
|
|
|
|
|
|
|
( defined( $n ) || $code == ECONNRESET || ( $IS_WIN32 && $code == ECONNABORTED ) ) ) |
1216
|
|
|
|
|
|
|
{ |
1217
|
|
|
|
|
|
|
# the server closed the connection (maybe because of keep-alive timeout) |
1218
|
0
|
|
|
|
|
|
$opts->{total_attempts}++; |
1219
|
0
|
|
|
|
|
|
return( $self->send( $req, %$opts ) ); |
1220
|
|
|
|
|
|
|
} |
1221
|
|
|
|
|
|
|
elsif( !length( $buff ) ) |
1222
|
|
|
|
|
|
|
{ |
1223
|
0
|
|
|
|
|
|
return( $self->error({ code => HTTP_BAD_REQUEST, message => "Unexpected EOF while reading response from socket '", $io->filehandle, "'." }) ); |
1224
|
|
|
|
|
|
|
} |
1225
|
|
|
|
|
|
|
elsif( !defined( $n ) ) |
1226
|
|
|
|
|
|
|
{ |
1227
|
0
|
|
|
|
|
|
return( $self->pass_error( $io->error ) ); |
1228
|
|
|
|
|
|
|
} |
1229
|
|
|
|
|
|
|
else |
1230
|
|
|
|
|
|
|
{ |
1231
|
0
|
|
|
|
|
|
return( $self->error({ code => HTTP_BAD_REQUEST, message => "No headers data could be retrieved in the first " . length( $buff ) . " bytes of data read." }) ); |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
} |
1234
|
|
|
|
|
|
|
|
1235
|
0
|
|
|
|
|
|
$def = $parser->parse_response_headers( \$buff ); |
1236
|
0
|
0
|
|
|
|
|
if( !defined( $def ) ) |
1237
|
|
|
|
|
|
|
{ |
1238
|
|
|
|
|
|
|
# Is it an error 425 Too Early, it means we need more data. |
1239
|
0
|
0
|
0
|
|
|
|
if( $parser->error->code == HTTP_TOO_EARLY ) |
|
|
0
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
{ |
1241
|
0
|
|
|
|
|
|
next LOOP; |
1242
|
|
|
|
|
|
|
} |
1243
|
|
|
|
|
|
|
# 400 Bad request |
1244
|
|
|
|
|
|
|
elsif( $parser->error->code == HTTP_BAD_REQUEST && length( $buff ) > $max ) |
1245
|
|
|
|
|
|
|
{ |
1246
|
0
|
|
|
|
|
|
return( $self->error({ code => HTTP_BAD_REQUEST, message => "Unable to find the response headers, within the first ${max} bytes of data. Do you need to increase the value for max_headers_size() ?" }) ); |
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
# For other errors, we stop and pass the error received |
1249
|
0
|
|
|
|
|
|
return( $self->pass_error ); |
1250
|
|
|
|
|
|
|
} |
1251
|
|
|
|
|
|
|
else |
1252
|
|
|
|
|
|
|
{ |
1253
|
|
|
|
|
|
|
$headers = $def->{headers} || |
1254
|
0
|
|
0
|
|
|
|
return( $self->error( "No headers object set by \$parser->parse_headers_xs() !" ) ); |
1255
|
0
|
0
|
|
|
|
|
return( $self->error( "\$parser->parse_headers_xs() did not return the headers length as an integer ($def->{length})" ) ) if( !$self->_is_integer( $def->{length} ) ); |
1256
|
0
|
0
|
|
|
|
|
return( $self->error( "Headers length returned by \$parser->parse_headers_xs() ($def->{length}) is higher than our buffer size (", length( $buff ), ") !" ) ) if( $def->{length} > length( $buff ) ); |
1257
|
|
|
|
|
|
|
# succeeded |
1258
|
0
|
|
|
|
|
|
substr( $buff, 0, $def->{length}, '' ); |
1259
|
0
|
|
|
|
|
|
$total_bytes_read += $def->{length}; |
1260
|
0
|
0
|
|
|
|
|
$io->unread( $buff ) if( length( $buff ) ); |
1261
|
|
|
|
|
|
|
# We need to consume the blank line separating the headers and the body, so it does |
1262
|
|
|
|
|
|
|
# not become part of the body, and because it does not belong anywhere |
1263
|
0
|
|
|
|
|
|
my $trash = $io->read_until_in_memory( qr/${CRLF}/, include => 1 ); |
1264
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $io->error ) ) if( !defined( $trash ) ); |
1265
|
0
|
0
|
|
|
|
|
if( $req->headers->exists( 'Expect' ) ) |
1266
|
|
|
|
|
|
|
{ |
1267
|
|
|
|
|
|
|
# If we initially sent an Expect request, i.e. without a body, we just got |
1268
|
|
|
|
|
|
|
# The green light to proceed, so we remove the Expect: 100-Continue header and re-submit. |
1269
|
|
|
|
|
|
|
# If we did not have that request header, we just read on as this is the final, albeit weird, response |
1270
|
0
|
0
|
|
|
|
|
if( $def->{code} == HTTP_CONTINUE ) |
|
|
0
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
{ |
1272
|
|
|
|
|
|
|
# Read on to get the actual server response headers |
1273
|
0
|
|
|
|
|
|
my $bytes = $send_body->( $req->entity ); |
1274
|
0
|
0
|
|
|
|
|
return( $self->pass_error ) if( !defined( $bytes ) ); |
1275
|
0
|
|
|
|
|
|
$total_bytes_sent += $bytes; |
1276
|
|
|
|
|
|
|
# moving on to read the full response headers |
1277
|
|
|
|
|
|
|
# Something like this: |
1278
|
|
|
|
|
|
|
# HTTP/1.1 100 Continue |
1279
|
|
|
|
|
|
|
# |
1280
|
|
|
|
|
|
|
# HTTP/1.1 200 OK |
1281
|
|
|
|
|
|
|
# Content-Type: text/plain |
1282
|
|
|
|
|
|
|
# Content-Length: 15 |
1283
|
|
|
|
|
|
|
# Host: example.com |
1284
|
|
|
|
|
|
|
# User-Agent: hoge |
1285
|
|
|
|
|
|
|
# |
1286
|
0
|
|
|
|
|
|
next LOOP; |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
# If this is a HTTP/1.0 protocol (but not limited to), this just means the server did not support |
1289
|
|
|
|
|
|
|
# the Expect: 100-Continue header, so we just remove it and re-submit. |
1290
|
|
|
|
|
|
|
elsif( $def->{code} == HTTP_EXPECTATION_FAILED ) |
1291
|
|
|
|
|
|
|
{ |
1292
|
0
|
|
|
|
|
|
$req->headers->remove( 'Expect' ); |
1293
|
|
|
|
|
|
|
# Disable the Expect feature |
1294
|
0
|
|
|
|
|
|
$opts->{expect_threshold} = 0; |
1295
|
0
|
|
|
|
|
|
return( $self->send( $req, $opts ) ); |
1296
|
|
|
|
|
|
|
} |
1297
|
|
|
|
|
|
|
} |
1298
|
0
|
|
|
|
|
|
last LOOP; |
1299
|
|
|
|
|
|
|
} |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
|
1302
|
0
|
0
|
0
|
|
|
|
my $ent = HTTP::Promise::Entity->new( |
1303
|
|
|
|
|
|
|
headers => $headers, |
1304
|
|
|
|
|
|
|
ext_vary => $self->ext_vary, |
1305
|
|
|
|
|
|
|
debug => $self->debug, |
1306
|
|
|
|
|
|
|
( ( $headers->exists( 'Content-Encoding' ) && !$headers->content_encoding->is_empty ) ? ( is_encoded => 1 ) : () ), |
1307
|
|
|
|
|
|
|
); |
1308
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::Response' ) || return( $self->pass_error ); |
1309
|
|
|
|
|
|
|
my $resp = HTTP::Promise::Response->new( @$def{qw( code status headers )}, { |
1310
|
|
|
|
|
|
|
protocol => $def->{protocol}, |
1311
|
|
|
|
|
|
|
version => $def->{version}, |
1312
|
0
|
|
0
|
|
|
|
debug => $self->debug, |
1313
|
|
|
|
|
|
|
} ) || return( $self->pass_error( HTTP::Promise::Response->error ) ); |
1314
|
|
|
|
|
|
|
# Mutual assignment for convenience |
1315
|
0
|
|
|
|
|
|
$resp->entity( $ent ); |
1316
|
0
|
|
|
|
|
|
$ent->http_message( $resp ); |
1317
|
0
|
|
|
|
|
|
$resp->request( $req ); |
1318
|
0
|
|
|
|
|
|
my $body; |
1319
|
|
|
|
|
|
|
|
1320
|
0
|
|
|
|
|
|
my $max_redirect = 0; |
1321
|
0
|
|
|
|
|
|
my $do_redirect = undef; |
1322
|
0
|
0
|
|
|
|
|
if( $headers->exists( 'Location' ) ) |
1323
|
|
|
|
|
|
|
{ |
1324
|
|
|
|
|
|
|
$max_redirect = ( defined( $opts->{max_redirect} ) && $opts->{max_redirect} =~ /^\d+$/ ) |
1325
|
|
|
|
|
|
|
? $opts->{max_redirect} |
1326
|
0
|
0
|
0
|
|
|
|
: $self->max_redirect; |
1327
|
0
|
|
0
|
|
|
|
$max_redirect //= 0; |
1328
|
|
|
|
|
|
|
# Perform redirect for: |
1329
|
|
|
|
|
|
|
# Moved Permanently (301), |
1330
|
|
|
|
|
|
|
# Moved Temporarily (302) |
1331
|
|
|
|
|
|
|
# See Other (303) |
1332
|
|
|
|
|
|
|
# Temporary Redirect (307) |
1333
|
|
|
|
|
|
|
# Permanent Redirect (308) |
1334
|
0
|
|
0
|
|
|
|
$do_redirect = ( $max_redirect && $def->{code} =~ /^30[12378]$/ ); |
1335
|
|
|
|
|
|
|
} |
1336
|
|
|
|
|
|
|
|
1337
|
0
|
|
0
|
|
|
|
my $chunked = ( ( $headers->transfer_encoding // '' ) eq 'chunked' ); |
1338
|
0
|
|
|
|
|
|
my $content_length = $headers->content_length; |
1339
|
0
|
0
|
0
|
|
|
|
if( defined( $content_length ) && |
|
|
|
0
|
|
|
|
|
1340
|
|
|
|
|
|
|
length( $content_length ) && |
1341
|
|
|
|
|
|
|
$content_length !~ /^\d+$/ ) |
1342
|
|
|
|
|
|
|
{ |
1343
|
|
|
|
|
|
|
# return( $self->error({ code => 500, message => "Bad Content-Length: ${content_length}" }) ); |
1344
|
0
|
0
|
|
|
|
|
warn( "Bad Content-Length '${content_length}' in server response.\n" ) if( $self->_warnings_is_enabled ); |
1345
|
0
|
|
|
|
|
|
undef( $content_length ); |
1346
|
|
|
|
|
|
|
} |
1347
|
|
|
|
|
|
|
|
1348
|
0
|
0
|
0
|
|
|
|
unless( $req->method eq 'HEAD' |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1349
|
|
|
|
|
|
|
|| ( $def->{code} >= 100 && $def->{code} < 200 ) |
1350
|
|
|
|
|
|
|
|| $def->{code} == 204 |
1351
|
|
|
|
|
|
|
|| $def->{code} == 304 ) |
1352
|
|
|
|
|
|
|
{ |
1353
|
0
|
0
|
|
|
|
|
if( $chunked ) |
1354
|
|
|
|
|
|
|
{ |
1355
|
0
|
|
|
|
|
|
$body = $self->_read_body_chunked( |
1356
|
|
|
|
|
|
|
reader => $io, |
1357
|
|
|
|
|
|
|
headers => $headers, |
1358
|
|
|
|
|
|
|
entity => $ent, |
1359
|
|
|
|
|
|
|
); |
1360
|
|
|
|
|
|
|
} |
1361
|
|
|
|
|
|
|
else |
1362
|
|
|
|
|
|
|
{ |
1363
|
0
|
|
|
|
|
|
$body = $self->_read_body( |
1364
|
|
|
|
|
|
|
reader => $io, |
1365
|
|
|
|
|
|
|
headers => $headers, |
1366
|
|
|
|
|
|
|
entity => $ent, |
1367
|
|
|
|
|
|
|
); |
1368
|
|
|
|
|
|
|
} |
1369
|
0
|
0
|
|
|
|
|
return( $self->pass_error ) if( !defined( $body ) ); |
1370
|
0
|
|
|
|
|
|
$total_bytes_read += $body->length; |
1371
|
0
|
|
|
|
|
|
$ent->body( $body ); |
1372
|
|
|
|
|
|
|
} |
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
# manage connection cache (i.e. keep-alive) |
1375
|
0
|
0
|
0
|
|
|
|
if( defined( $connection_header ) && |
1376
|
|
|
|
|
|
|
lc( $connection_header ) eq 'keep-alive' ) |
1377
|
|
|
|
|
|
|
{ |
1378
|
0
|
|
|
|
|
|
my $connection = $headers->connection->lc; |
1379
|
0
|
0
|
0
|
|
|
|
if( ( $def->{version} > 1.0 |
|
|
0
|
0
|
|
|
|
|
1380
|
|
|
|
|
|
|
? $connection ne 'close' # HTTP/1.1 can keep alive by default |
1381
|
|
|
|
|
|
|
: $connection eq 'keep-alive' # HTTP/1.0 needs explicit keep-alive |
1382
|
|
|
|
|
|
|
) && ( defined( $content_length ) or $chunked ) ) |
1383
|
|
|
|
|
|
|
{ |
1384
|
0
|
|
|
|
|
|
my $sock = $io->filehandle; |
1385
|
0
|
0
|
|
|
|
|
$self->_pool->push( $uri->host, $uri->port, $sock ) || |
1386
|
|
|
|
|
|
|
return( $self->pass_error ); |
1387
|
|
|
|
|
|
|
} |
1388
|
|
|
|
|
|
|
} |
1389
|
|
|
|
|
|
|
# explicitly close here, just after returning the socket to the pool, |
1390
|
|
|
|
|
|
|
# since it might be reused in the upcoming recursive call |
1391
|
|
|
|
|
|
|
# undef( $sock ); |
1392
|
0
|
|
|
|
|
|
$io->close; |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
# Process 'Set-Cookie' header before redirect, because Cookies may have been set upon redirection. |
1395
|
0
|
0
|
|
|
|
|
if( defined( $cookie_jar ) ) |
1396
|
|
|
|
|
|
|
{ |
1397
|
0
|
0
|
|
|
|
|
$cookie_jar->add_response_header( $resp ) || |
1398
|
|
|
|
|
|
|
return( $self->pass_error( $cookie_jar->error ) ); |
1399
|
|
|
|
|
|
|
} |
1400
|
|
|
|
|
|
|
|
1401
|
0
|
0
|
|
|
|
|
if( $do_redirect ) |
1402
|
|
|
|
|
|
|
{ |
1403
|
0
|
|
|
|
|
|
my $location = $headers->location; |
1404
|
0
|
0
|
|
|
|
|
unless( $location =~ m{^[a-zA-Z][a-zA-Z0-9]+://} ) |
1405
|
|
|
|
|
|
|
{ |
1406
|
|
|
|
|
|
|
# RFC 2616 14.30 says Location header is absolute URI. |
1407
|
|
|
|
|
|
|
# But, a lot of servers return relative URI. |
1408
|
0
|
|
|
|
|
|
$location = URI->new_abs( $location => $uri ); |
1409
|
|
|
|
|
|
|
} |
1410
|
|
|
|
|
|
|
# Note: RFC 1945 and RFC 2068 specify that the client is not allowed |
1411
|
|
|
|
|
|
|
# to change the method on the redirected request. However, most |
1412
|
|
|
|
|
|
|
# existing user agent implementations treat 302 as if it were a 303 |
1413
|
|
|
|
|
|
|
# response, performing a GET on the Location field-value regardless |
1414
|
|
|
|
|
|
|
# of the original request method. The status codes 303 and 307 have |
1415
|
|
|
|
|
|
|
# been added for servers that wish to make unambiguously clear which |
1416
|
|
|
|
|
|
|
# kind of reaction is expected of the client. Also, 308 was introduced |
1417
|
|
|
|
|
|
|
# to avoid the ambiguity of 301. |
1418
|
|
|
|
|
|
|
# TODO: Create new object and add the old one as previous() to the new request. |
1419
|
0
|
|
0
|
|
|
|
my $clone = $req->clone || return( $self->pass_error( $req->error ) ); |
1420
|
0
|
0
|
|
|
|
|
unless( $def->{code} =~ /^30[178]$/ ) |
1421
|
|
|
|
|
|
|
{ |
1422
|
0
|
|
|
|
|
|
$clone->method( 'GET' ); |
1423
|
|
|
|
|
|
|
} |
1424
|
0
|
|
|
|
|
|
$clone->uri( $location ); |
1425
|
0
|
0
|
|
|
|
|
$max_redirect-- if( $max_redirect > 0 ); |
1426
|
0
|
|
|
|
|
|
$opts->{max_redirect} = $max_redirect; |
1427
|
0
|
|
|
|
|
|
return( $self->send( $clone, $opts ) ); |
1428
|
0
|
|
0
|
|
|
|
my $resp2 = $self->send( $clone, $opts ) || |
1429
|
|
|
|
|
|
|
return( $self->pass_error ); |
1430
|
0
|
|
|
|
|
|
$resp2->previous( $resp ); |
1431
|
0
|
|
|
|
|
|
return( $resp2 ); |
1432
|
|
|
|
|
|
|
} |
1433
|
|
|
|
|
|
|
|
1434
|
0
|
|
|
|
|
|
my $type = $ent->mime_type; |
1435
|
|
|
|
|
|
|
# I we have a body at and it is a multipart, we parse it otherwise, we already have it stored |
1436
|
0
|
0
|
0
|
|
|
|
if( $ent->body && $type =~ m,^multipart/,i ) |
1437
|
|
|
|
|
|
|
{ |
1438
|
|
|
|
|
|
|
# Now parse the raw data saved earlier |
1439
|
0
|
|
0
|
|
|
|
my $fh = $ent->body->open( '+<', { binmode => 'raw' } ) || |
1440
|
|
|
|
|
|
|
return( $self->pass_error( $ent->body->error ) ); |
1441
|
0
|
|
0
|
|
|
|
my $reader = HTTP::Promise::IO->new( $fh, max_read_buffer => $bufsize, debug => $self->debug ) || |
1442
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::IO->error ) ); |
1443
|
0
|
|
0
|
|
|
|
my $ent2 = HTTP::Promise::Entity->new( headers => $headers, http_message => $resp, debug => $self->debug ) || |
1444
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Entity->error ) ); |
1445
|
0
|
|
|
|
|
|
$resp->entity( $ent2 ); |
1446
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
# Request body can be one of 3 types: |
1448
|
|
|
|
|
|
|
# application/x-www-form-urlencoded |
1449
|
|
|
|
|
|
|
# multipart/form-data |
1450
|
|
|
|
|
|
|
# text/plain or other mime types |
1451
|
|
|
|
|
|
|
# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Methods/POST> |
1452
|
0
|
|
0
|
|
|
|
my $part_ent = $parser->parse_multi_part( entity => $ent2, reader => $reader ) || |
1453
|
|
|
|
|
|
|
return( $parser->pass_error ); |
1454
|
|
|
|
|
|
|
} |
1455
|
|
|
|
|
|
|
|
1456
|
0
|
|
|
|
|
|
return( $resp ); |
1457
|
|
|
|
|
|
|
} |
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
# NOTE: request parameter |
1460
|
0
|
|
|
0
|
1
|
|
sub send_te { return( shift->_set_get_boolean( 'send_te', @_ ) ); } |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
# NOTE: serialiser method for Promise::Me |
1463
|
0
|
|
|
0
|
1
|
|
sub serialiser { return( shift->_set_get_scalar( 'serialiser', @_ ) ); } |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
# NOTE: shared_mem_size method for Promise::Me |
1466
|
0
|
|
|
0
|
1
|
|
sub shared_mem_size { return( shift->_set_get_scalar( 'shared_mem_size', @_ ) ); } |
1467
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
sub simple_request |
1469
|
|
|
|
|
|
|
{ |
1470
|
0
|
|
|
0
|
1
|
|
my $self = shift( @_ ); |
1471
|
0
|
|
|
|
|
|
my $req = shift( @_ ); |
1472
|
0
|
|
|
|
|
|
my $opts = $self->_get_args_as_hash( @_ ); |
1473
|
0
|
|
0
|
|
|
|
$opts->{read_size} //= 0; |
1474
|
0
|
0
|
|
|
|
|
if( $self->use_promise ) |
1475
|
|
|
|
|
|
|
{ |
1476
|
|
|
|
|
|
|
return( Promise::Me->new(sub |
1477
|
|
|
|
|
|
|
{ |
1478
|
0
|
|
|
0
|
|
|
my( $resolve, $reject ) = @$_; |
1479
|
0
|
0
|
|
|
|
|
return( $reject->( HTTP::Promise::Exception->new({ |
1480
|
|
|
|
|
|
|
code => 500, |
1481
|
|
|
|
|
|
|
message => "No request object was provided." |
1482
|
|
|
|
|
|
|
}) ) ) if( !$req ); |
1483
|
0
|
0
|
|
|
|
|
$self->use_content_file( $opts->{use_content_file} ) if( exists( $opts->{use_content_file} ) ); |
1484
|
0
|
|
|
|
|
|
$opts->{max_redirect} = 0; |
1485
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req, $opts ) || return( $reject->( $self->pass_error ) ); |
1486
|
0
|
|
|
|
|
|
return( $resolve->( $resp ) ); |
1487
|
0
|
|
|
|
|
|
}) ); |
1488
|
|
|
|
|
|
|
} |
1489
|
|
|
|
|
|
|
else |
1490
|
|
|
|
|
|
|
{ |
1491
|
0
|
0
|
|
|
|
|
return( $self->error( "No request object was provided." ) ) if( !$req ); |
1492
|
0
|
0
|
|
|
|
|
$self->use_content_file( $opts->{use_content_file} ) if( exists( $opts->{use_content_file} ) ); |
1493
|
0
|
|
|
|
|
|
$opts->{max_redirect} = 0; |
1494
|
0
|
|
0
|
|
|
|
my $resp = $self->send( $req, $opts ) || return( $self->pass_error ); |
1495
|
0
|
|
|
|
|
|
return( $resp ); |
1496
|
|
|
|
|
|
|
} |
1497
|
|
|
|
|
|
|
} |
1498
|
|
|
|
|
|
|
|
1499
|
0
|
|
|
0
|
1
|
|
sub stop_if { return( shift->_set_get_code( 'stop_if', @_ ) ); } |
1500
|
|
|
|
|
|
|
|
1501
|
0
|
|
|
0
|
1
|
|
sub threshold { return( shift->_set_get_scalar( 'threshold', @_ ) ); } |
1502
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
# NOTE: request parameter |
1504
|
0
|
|
|
0
|
1
|
|
sub timeout { return( shift->_set_get_number( 'timeout', @_ ) ); } |
1505
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
# NOTE: upgrade_insecure_requestsis an alias for auto_switch_https |
1507
|
0
|
|
|
0
|
1
|
|
sub upgrade_insecure_requests { return( shift->_set_get_boolean( 'auto_switch_https', @_ ) ); } |
1508
|
|
|
|
|
|
|
|
1509
|
0
|
|
|
0
|
1
|
|
sub uri_escape { return( URI::Escape::XS::uri_escape( $_[1] ) ); } |
1510
|
|
|
|
|
|
|
|
1511
|
0
|
|
|
0
|
1
|
|
sub uri_unescape { return( URI::Escape::XS::uri_unescape( $_[1] ) ); } |
1512
|
|
|
|
|
|
|
|
1513
|
0
|
|
|
0
|
1
|
|
sub use_content_file { return( shift->_set_get_boolean( 'use_content_file', @_ ) ); } |
1514
|
|
|
|
|
|
|
|
1515
|
0
|
|
|
0
|
1
|
|
sub use_promise { return( shift->_set_get_boolean( 'use_promise', @_ ) ); } |
1516
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
sub _datetime |
1518
|
|
|
|
|
|
|
{ |
1519
|
0
|
|
|
0
|
|
|
my $self = shift( @_ ); |
1520
|
0
|
|
|
|
|
|
my $dt; |
1521
|
0
|
0
|
|
|
|
|
if( @_ ) |
1522
|
|
|
|
|
|
|
{ |
1523
|
0
|
0
|
|
|
|
|
return( $self->error( "Object provided (", ref( $_[0] ), ") is not a DateTime or Module::Generic::DateTime object." ) ) if( !$self->_is_a( $_[0] => [qw( DateTime Module::Generic::DateTime )] ) ); |
1524
|
0
|
|
|
|
|
|
$dt = shift( @_ ); |
1525
|
|
|
|
|
|
|
} |
1526
|
|
|
|
|
|
|
|
1527
|
0
|
0
|
|
|
|
|
if( !defined( $dt ) ) |
|
|
0
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
{ |
1529
|
0
|
|
|
|
|
|
$dt = DateTime->now; |
1530
|
|
|
|
|
|
|
} |
1531
|
|
|
|
|
|
|
# We need to get the underlying DateTime object if it is wrapped inside Module::Generic::DateTime |
1532
|
|
|
|
|
|
|
elsif( $dt->isa( 'Module::Generic::DateTime' ) ) |
1533
|
|
|
|
|
|
|
{ |
1534
|
0
|
|
|
|
|
|
$dt = $dt->datetime; |
1535
|
|
|
|
|
|
|
} |
1536
|
|
|
|
|
|
|
|
1537
|
0
|
|
|
|
|
|
$dt->set_time_zone( 'GMT' ); |
1538
|
0
|
|
|
|
|
|
my $fmt = DateTime::Format::Strptime->new( |
1539
|
|
|
|
|
|
|
pattern => '%a, %d %b %Y %H:%M:%S GMT', |
1540
|
|
|
|
|
|
|
locale => 'en_GB', |
1541
|
|
|
|
|
|
|
time_zone => 'GMT', |
1542
|
|
|
|
|
|
|
); |
1543
|
0
|
|
|
|
|
|
$dt->set_formatter( $fmt ); |
1544
|
0
|
|
|
|
|
|
return( $dt ); |
1545
|
|
|
|
|
|
|
} |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
# my $res = $prom->_make_request_data( $form_object ); |
1548
|
|
|
|
|
|
|
# my $res = $prom->_make_request_data( $form_data_object ); |
1549
|
|
|
|
|
|
|
# my $res = $prom->_make_request_data( 'post' => $url, \%form ); |
1550
|
|
|
|
|
|
|
# my $res = $prom->_make_request_data( 'post' => $url, \%form ); |
1551
|
|
|
|
|
|
|
# my $res = $prom->_make_request_data( 'post' => $url, \@form ); |
1552
|
|
|
|
|
|
|
# my $res = $prom->_make_request_data( 'post' => $url, \%form, $field_name => $value, ... ); |
1553
|
|
|
|
|
|
|
# my $res = $prom->_make_request_data( 'post' => $url, $field_name => $value, Content => \%form, Query => $escaped_string ); |
1554
|
|
|
|
|
|
|
# my $res = $prom->_make_request_data( 'post' => $url, $field_name => $value, Content => \@form, Query => $escaped_string ); |
1555
|
|
|
|
|
|
|
# my $res = $prom->_make_request_data( 'post' => $url, $field_name => $value, Content => $content, Query => $escaped_string ); |
1556
|
|
|
|
|
|
|
sub _make_request_data |
1557
|
|
|
|
|
|
|
{ |
1558
|
0
|
|
|
0
|
|
|
my $self = shift( @_ ); |
1559
|
0
|
|
0
|
|
|
|
my $meth = shift( @_ ) || return( $self->error( 'No http method was provided.' ) ); |
1560
|
0
|
|
0
|
|
|
|
my $uri = shift( @_ ) || return( $self->error( 'No uri was provided.' ) ); |
1561
|
0
|
|
0
|
|
|
|
my $req = HTTP::Promise::Request->new( $meth => $uri, { debug => $self->debug } ) || |
1562
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Request->error ) ); |
1563
|
0
|
|
|
|
|
|
$self->prepare_headers( $req ); |
1564
|
|
|
|
|
|
|
# To set up a possible escaped query string for this POST/PUT request |
1565
|
0
|
|
0
|
|
|
|
my $u = $req->uri || |
1566
|
|
|
|
|
|
|
return( $self->error( "No URL was provided for this HTTP query." ) ); |
1567
|
0
|
|
|
|
|
|
my $ent = $req->entity; |
1568
|
0
|
|
|
|
|
|
my $content; |
1569
|
|
|
|
|
|
|
# Maybe content is provided as the first argument? |
1570
|
0
|
0
|
0
|
|
|
|
if( scalar( @_ ) && defined( $_[0] ) && |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1571
|
|
|
|
|
|
|
( |
1572
|
|
|
|
|
|
|
$self->_is_array( $_[0] ) || |
1573
|
|
|
|
|
|
|
ref( $_[0] ) eq 'HASH' || |
1574
|
|
|
|
|
|
|
$self->_is_a( $_[0] => 'HTTP::Promise::Body::Form' ) || |
1575
|
|
|
|
|
|
|
$self->_is_a( $_[0] => 'HTTP::Promise::Body::Form::Data' ) |
1576
|
|
|
|
|
|
|
) ) |
1577
|
|
|
|
|
|
|
{ |
1578
|
0
|
|
|
|
|
|
$content = shift( @_ ); |
1579
|
|
|
|
|
|
|
} |
1580
|
|
|
|
|
|
|
# Maybe content is provided as the last argument? |
1581
|
|
|
|
|
|
|
elsif( scalar( @_ ) && |
1582
|
|
|
|
|
|
|
( @_ % 2 ) && |
1583
|
|
|
|
|
|
|
defined( $_[-1] ) && |
1584
|
|
|
|
|
|
|
( |
1585
|
|
|
|
|
|
|
$self->_is_array( $_[-1] ) || |
1586
|
|
|
|
|
|
|
ref( $_[-1] ) eq 'HASH' || |
1587
|
|
|
|
|
|
|
$self->_is_a( $_[-1] => 'HTTP::Promise::Body::Form' ) || |
1588
|
|
|
|
|
|
|
$self->_is_a( $_[-1] => 'HTTP::Promise::Body::Form::Data' ) |
1589
|
|
|
|
|
|
|
) ) |
1590
|
|
|
|
|
|
|
{ |
1591
|
0
|
|
|
|
|
|
$content = pop( @_ ); |
1592
|
|
|
|
|
|
|
} |
1593
|
|
|
|
|
|
|
|
1594
|
0
|
|
|
|
|
|
my( $k, $v ); |
1595
|
0
|
|
|
|
|
|
while( ( $k, $v ) = splice( @_, 0, 2 ) ) |
1596
|
|
|
|
|
|
|
{ |
1597
|
0
|
0
|
|
|
|
|
if( lc( $k ) eq 'content' ) |
|
|
0
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
{ |
1599
|
0
|
|
|
|
|
|
$content = $v; |
1600
|
|
|
|
|
|
|
} |
1601
|
|
|
|
|
|
|
# Handle possible escaped query string for this POST/PUT request |
1602
|
|
|
|
|
|
|
elsif( lc( $k ) eq 'query' ) |
1603
|
|
|
|
|
|
|
{ |
1604
|
0
|
0
|
0
|
|
|
|
if( ref( $v ) eq 'HASH' || $self->_is_array( $v ) ) |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1605
|
|
|
|
|
|
|
{ |
1606
|
|
|
|
|
|
|
# try-catch |
1607
|
0
|
|
|
|
|
|
local $@; |
1608
|
|
|
|
|
|
|
eval |
1609
|
0
|
|
|
|
|
|
{ |
1610
|
0
|
|
|
|
|
|
$u->query_form( $v ); |
1611
|
|
|
|
|
|
|
}; |
1612
|
0
|
0
|
|
|
|
|
if( $@ ) |
1613
|
|
|
|
|
|
|
{ |
1614
|
0
|
|
|
|
|
|
return( $self->error( "Error while setting query form key-value pairs: $@" ) ); |
1615
|
|
|
|
|
|
|
} |
1616
|
|
|
|
|
|
|
} |
1617
|
|
|
|
|
|
|
elsif( !ref( $v ) || ( ref( $v ) && overload::Method( $v => '""' ) ) ) |
1618
|
|
|
|
|
|
|
{ |
1619
|
0
|
|
|
|
|
|
$u->query( "$v" ); |
1620
|
|
|
|
|
|
|
} |
1621
|
|
|
|
|
|
|
} |
1622
|
|
|
|
|
|
|
else |
1623
|
|
|
|
|
|
|
{ |
1624
|
|
|
|
|
|
|
# $req->headers->push_header( $k, $v ); |
1625
|
0
|
|
|
|
|
|
$req->headers->replace( $k, $v ); |
1626
|
|
|
|
|
|
|
} |
1627
|
|
|
|
|
|
|
} |
1628
|
0
|
|
|
|
|
|
my $orig_ct = $req->headers->header( 'Content-Type' ); |
1629
|
0
|
|
|
|
|
|
my $ct = $orig_ct; |
1630
|
0
|
|
|
|
|
|
my( $obj, $type ); |
1631
|
|
|
|
|
|
|
# By default |
1632
|
0
|
0
|
0
|
|
|
|
if( !$ct && defined( $content ) ) |
|
|
0
|
0
|
|
|
|
|
1633
|
|
|
|
|
|
|
{ |
1634
|
0
|
|
|
|
|
|
$ct = 'application/x-www-form-urlencoded'; |
1635
|
|
|
|
|
|
|
} |
1636
|
|
|
|
|
|
|
elsif( $ct && $ct eq 'form-data' ) |
1637
|
|
|
|
|
|
|
{ |
1638
|
0
|
|
|
|
|
|
$ct = 'multipart/form-data'; |
1639
|
|
|
|
|
|
|
} |
1640
|
|
|
|
|
|
|
|
1641
|
0
|
0
|
0
|
|
|
|
if( defined( $ct ) && length( "$ct" ) ) |
1642
|
|
|
|
|
|
|
{ |
1643
|
0
|
|
|
|
|
|
$obj = $req->headers->new_field( 'Content-Type' => "$ct" ); |
1644
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $req->headers->error ) ) if( !defined( $obj ) ); |
1645
|
0
|
|
|
|
|
|
$type = $obj->type; |
1646
|
|
|
|
|
|
|
} |
1647
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
# $content can be an array reference, hash reference, an HTTP::Promise::Body::Form object, or an HTTP::Promise::Body::Form::Data object |
1649
|
0
|
0
|
0
|
|
|
|
if( ref( $content ) ) |
|
|
0
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
{ |
1651
|
|
|
|
|
|
|
# if( $ct =~ m,^multipart/form-data[[:blank:]\h]*(;|$),i ) |
1652
|
0
|
0
|
0
|
|
|
|
if( lc( substr( "$type", 0, 19 ) ) eq 'multipart/form-data' ) |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1653
|
|
|
|
|
|
|
{ |
1654
|
0
|
0
|
|
|
|
|
unless( $obj->boundary ) |
1655
|
|
|
|
|
|
|
{ |
1656
|
0
|
|
|
|
|
|
$obj->boundary( $req->make_boundary ); |
1657
|
|
|
|
|
|
|
} |
1658
|
|
|
|
|
|
|
# HTTP::Promise::Body::Form::Data inherits from HTTP::Promise::Body::Form, so we do it first |
1659
|
0
|
0
|
|
|
|
|
if( $self->_is_a( $content => 'HTTP::Promise::Body::Form::Data' ) ) |
1660
|
|
|
|
|
|
|
{ |
1661
|
0
|
|
0
|
|
|
|
my $parts = $content->make_parts || |
1662
|
|
|
|
|
|
|
return( $self->pass_error( $content->error ) ); |
1663
|
0
|
|
|
|
|
|
$ent->parts( $parts ); |
1664
|
|
|
|
|
|
|
} |
1665
|
0
|
0
|
|
|
|
|
if( $self->_is_a( $content => 'HTTP::Promise::Body::Form' ) ) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
{ |
1667
|
0
|
|
0
|
|
|
|
my $form = $content->as_form_data || |
1668
|
|
|
|
|
|
|
return( $self->pass_error( $content->error ) ); |
1669
|
0
|
|
0
|
|
|
|
my $parts = $form->make_parts || |
1670
|
|
|
|
|
|
|
return( $self->pass_error( $form->error ) ); |
1671
|
0
|
|
|
|
|
|
$ent->parts( $parts ); |
1672
|
|
|
|
|
|
|
} |
1673
|
|
|
|
|
|
|
elsif( $self->_is_array( $content ) ) |
1674
|
|
|
|
|
|
|
{ |
1675
|
|
|
|
|
|
|
# Keep track of the order of the fields |
1676
|
0
|
|
|
|
|
|
my $fields = []; |
1677
|
0
|
|
|
|
|
|
for( my $i = 0; $i < scalar( @$content ); $i += 2 ) |
1678
|
|
|
|
|
|
|
{ |
1679
|
0
|
|
|
|
|
|
push( @$fields, $content->[$i] ); |
1680
|
|
|
|
|
|
|
} |
1681
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::Body::Form::Data' ) || |
1682
|
|
|
|
|
|
|
return( $self->pass_error ); |
1683
|
0
|
|
0
|
|
|
|
my $form = HTTP::Promise::Body::Form::Data->new( @$content ) || |
1684
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Body::Form::Data->error ) ); |
1685
|
0
|
|
0
|
|
|
|
my $parts = $form->make_parts( fields => $fields ) || |
1686
|
|
|
|
|
|
|
return( $self->pass_error( $form->error ) ); |
1687
|
0
|
|
|
|
|
|
$ent->parts( $parts ); |
1688
|
|
|
|
|
|
|
} |
1689
|
|
|
|
|
|
|
elsif( ref( $content ) eq 'HASH' ) |
1690
|
|
|
|
|
|
|
{ |
1691
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::Body::Form::Data' ) || |
1692
|
|
|
|
|
|
|
return( $self->pass_error ); |
1693
|
0
|
|
0
|
|
|
|
my $form = HTTP::Promise::Body::Form::Data->new( $content ) || |
1694
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Body::Form::Data->error ) ); |
1695
|
0
|
|
0
|
|
|
|
my $parts = $form->make_parts || |
1696
|
|
|
|
|
|
|
return( $self->pass_error( $form->error ) ); |
1697
|
0
|
|
|
|
|
|
$ent->parts( $parts ); |
1698
|
|
|
|
|
|
|
} |
1699
|
|
|
|
|
|
|
else |
1700
|
|
|
|
|
|
|
{ |
1701
|
0
|
|
|
|
|
|
return( $self->error( "Unsupported content of type '", ref( $content ), "'" ) ); |
1702
|
|
|
|
|
|
|
} |
1703
|
|
|
|
|
|
|
} |
1704
|
|
|
|
|
|
|
elsif( lc( $type ) eq TYPE_URL_ENCODED && |
1705
|
|
|
|
|
|
|
( |
1706
|
|
|
|
|
|
|
Scalar::Util::reftype( $content ) eq 'ARRAY' || |
1707
|
|
|
|
|
|
|
ref( $content ) eq 'HASH' || |
1708
|
|
|
|
|
|
|
$self->_is_a( $content => 'HTTP::Promise::Body::Form' ) |
1709
|
|
|
|
|
|
|
) ) |
1710
|
|
|
|
|
|
|
{ |
1711
|
0
|
|
|
|
|
|
my $form; |
1712
|
0
|
0
|
|
|
|
|
if( $self->_is_a( $content => 'HTTP::Promise::Body::Form' ) ) |
1713
|
|
|
|
|
|
|
{ |
1714
|
0
|
|
|
|
|
|
$form = $content; |
1715
|
|
|
|
|
|
|
} |
1716
|
|
|
|
|
|
|
else |
1717
|
|
|
|
|
|
|
{ |
1718
|
0
|
|
|
|
|
|
my $reftype = Scalar::Util::reftype( $content ); |
1719
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::Body::Form' ) || |
1720
|
|
|
|
|
|
|
return( $self->pass_error ); |
1721
|
0
|
|
0
|
|
|
|
$form = HTTP::Promise::Body::Form->new( $reftype eq 'ARRAY' ? @$content : $content ) || |
1722
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Body::Form->error ) ); |
1723
|
|
|
|
|
|
|
} |
1724
|
0
|
|
|
|
|
|
$ent->body( $form ); |
1725
|
|
|
|
|
|
|
} |
1726
|
|
|
|
|
|
|
elsif( $self->_is_a( $content => 'HTTP::Promise::Body' ) ) |
1727
|
|
|
|
|
|
|
{ |
1728
|
0
|
|
|
|
|
|
$ent->body( $content ); |
1729
|
|
|
|
|
|
|
} |
1730
|
|
|
|
|
|
|
# Module::Generic::File has stringification overloaded, so we put it here first |
1731
|
|
|
|
|
|
|
elsif( $self->_is_a( $content => 'Module::Generic::File' ) ) |
1732
|
|
|
|
|
|
|
{ |
1733
|
0
|
|
0
|
|
|
|
my $body = $ent->new_body( file => $content ) || |
1734
|
|
|
|
|
|
|
return( $self->pass_error( $ent->error ) ); |
1735
|
0
|
|
|
|
|
|
$ent->body( $body ); |
1736
|
|
|
|
|
|
|
} |
1737
|
|
|
|
|
|
|
elsif( overload::Method( $content => '""' ) ) |
1738
|
|
|
|
|
|
|
{ |
1739
|
0
|
|
0
|
|
|
|
my $body = $ent->new_body( string => "$content" ) || |
1740
|
|
|
|
|
|
|
return( $self->pass_error( $ent->error ) ); |
1741
|
0
|
|
|
|
|
|
$ent->body( $body ); |
1742
|
|
|
|
|
|
|
} |
1743
|
|
|
|
|
|
|
else |
1744
|
|
|
|
|
|
|
{ |
1745
|
0
|
|
|
|
|
|
return( $self->error( "Unsupported Content-Type: $ct for data type '", ref( $content ), "'" ) ); |
1746
|
|
|
|
|
|
|
} |
1747
|
|
|
|
|
|
|
} |
1748
|
|
|
|
|
|
|
# $content is not a reference and is not empty |
1749
|
|
|
|
|
|
|
elsif( defined( $content ) && length( $content ) ) |
1750
|
|
|
|
|
|
|
{ |
1751
|
0
|
|
0
|
|
|
|
my $body = $ent->new_body( string => $content ) || |
1752
|
|
|
|
|
|
|
return( $self->pass_error( $ent->error ) ); |
1753
|
0
|
|
|
|
|
|
$ent->body( $body ); |
1754
|
|
|
|
|
|
|
} |
1755
|
|
|
|
|
|
|
|
1756
|
|
|
|
|
|
|
# Set Content-Type if needed |
1757
|
0
|
0
|
0
|
|
|
|
$req->headers->content_type( "$obj" ) if( defined( $obj ) && !$orig_ct ); |
1758
|
0
|
0
|
|
|
|
|
if( defined( $content ) ) |
|
|
0
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
{ |
1760
|
|
|
|
|
|
|
# Make sure the content is encoded, if applicable, so we can get the proper content length. |
1761
|
0
|
0
|
|
|
|
|
if( my $encodings = $req->headers->content_encoding ) |
1762
|
|
|
|
|
|
|
{ |
1763
|
0
|
0
|
|
|
|
|
$ent->encode_body( $encodings ) if( !$ent->is_encoded ); |
1764
|
|
|
|
|
|
|
} |
1765
|
0
|
|
|
|
|
|
$req->content_length( $ent->body->length ); |
1766
|
|
|
|
|
|
|
} |
1767
|
|
|
|
|
|
|
# Set the Content-Length to 0 only if there is a Content-Type set |
1768
|
|
|
|
|
|
|
elsif( $ct ) |
1769
|
|
|
|
|
|
|
{ |
1770
|
0
|
|
|
|
|
|
$req->header( 'Content-Length' => 0 ); |
1771
|
|
|
|
|
|
|
} |
1772
|
0
|
|
|
|
|
|
return( $req ); |
1773
|
|
|
|
|
|
|
} |
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
sub _make_request_query |
1776
|
|
|
|
|
|
|
{ |
1777
|
0
|
|
|
0
|
|
|
my $self = shift( @_ ); |
1778
|
0
|
|
0
|
|
|
|
my $meth = shift( @_ ) || return( $self->error( 'No http method was provided.' ) ); |
1779
|
0
|
|
0
|
|
|
|
my $uri = shift( @_ ) || return( $self->error( 'No uri was provided.' ) ); |
1780
|
0
|
|
0
|
|
|
|
my $req = HTTP::Promise::Request->new( $meth => $uri, { debug => $self->debug } ) || |
1781
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Request->error ) ); |
1782
|
0
|
|
|
|
|
|
$self->prepare_headers( $req ); |
1783
|
0
|
|
0
|
|
|
|
my $u = $req->uri || |
1784
|
|
|
|
|
|
|
return( $self->error( "No URL was provided for this HTTP query." ) ); |
1785
|
0
|
|
|
|
|
|
my( $k, $v ); |
1786
|
0
|
|
|
|
|
|
while( ( $k, $v ) = splice( @_, 0, 2 ) ) |
1787
|
|
|
|
|
|
|
{ |
1788
|
0
|
0
|
0
|
|
|
|
if( lc( $k ) eq 'content' || lc( $k ) eq 'query' ) |
1789
|
|
|
|
|
|
|
{ |
1790
|
0
|
0
|
0
|
|
|
|
if( ref( $v ) eq 'HASH' || $self->_is_array( $v ) ) |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1791
|
|
|
|
|
|
|
{ |
1792
|
|
|
|
|
|
|
# try-catch |
1793
|
0
|
|
|
|
|
|
local $@; |
1794
|
|
|
|
|
|
|
eval |
1795
|
0
|
|
|
|
|
|
{ |
1796
|
0
|
|
|
|
|
|
$u->query_form( $v ); |
1797
|
|
|
|
|
|
|
}; |
1798
|
0
|
0
|
|
|
|
|
if( $@ ) |
1799
|
|
|
|
|
|
|
{ |
1800
|
0
|
|
|
|
|
|
return( $self->error( "Error while setting query form key-value pairs: $@" ) ); |
1801
|
|
|
|
|
|
|
} |
1802
|
|
|
|
|
|
|
} |
1803
|
|
|
|
|
|
|
elsif( !ref( $v ) || ( ref( $v ) && overload::Method( $v => '""' ) ) ) |
1804
|
|
|
|
|
|
|
{ |
1805
|
0
|
|
|
|
|
|
$u->query( "$v" ); |
1806
|
|
|
|
|
|
|
} |
1807
|
|
|
|
|
|
|
else |
1808
|
|
|
|
|
|
|
{ |
1809
|
0
|
0
|
|
|
|
|
warn( "Option \"$k\" was provided, but no content data (", overload::StrVal( $v ), ") is allowed for this type of HTTP query. Ignoring it.\n" ) if( $self->_warnings_is_enabled ); |
1810
|
|
|
|
|
|
|
} |
1811
|
|
|
|
|
|
|
} |
1812
|
|
|
|
|
|
|
else |
1813
|
|
|
|
|
|
|
{ |
1814
|
|
|
|
|
|
|
# $req->headers->push_header( $k, $v ); |
1815
|
0
|
|
|
|
|
|
$req->headers->replace( $k, $v ); |
1816
|
|
|
|
|
|
|
} |
1817
|
|
|
|
|
|
|
} |
1818
|
0
|
|
|
|
|
|
return( $req ); |
1819
|
|
|
|
|
|
|
} |
1820
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
sub _match_no_proxy |
1822
|
|
|
|
|
|
|
{ |
1823
|
0
|
|
|
0
|
|
|
my( $self, $no_proxy, $host ) = @_; |
1824
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
# ref. curl.1. |
1826
|
|
|
|
|
|
|
# list of host names that shouldn't go through any proxy. |
1827
|
|
|
|
|
|
|
# If set to a asterisk '*' only, it matches all hosts. |
1828
|
0
|
0
|
|
|
|
|
if( $no_proxy eq '*' ) |
|
|
0
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
{ |
1830
|
0
|
|
|
|
|
|
return(1); |
1831
|
|
|
|
|
|
|
} |
1832
|
|
|
|
|
|
|
elsif( $self->_is_array( $no_proxy ) ) |
1833
|
|
|
|
|
|
|
{ |
1834
|
0
|
|
|
|
|
|
for my $pat ( @$no_proxy ) |
1835
|
|
|
|
|
|
|
{ |
1836
|
|
|
|
|
|
|
# suffix match (same behavior as LWP) |
1837
|
0
|
0
|
|
|
|
|
if( $host =~ /\Q$pat\E$/ ) |
1838
|
|
|
|
|
|
|
{ |
1839
|
0
|
|
|
|
|
|
return(1); |
1840
|
|
|
|
|
|
|
} |
1841
|
|
|
|
|
|
|
} |
1842
|
|
|
|
|
|
|
} |
1843
|
0
|
|
|
|
|
|
return(0); |
1844
|
|
|
|
|
|
|
} |
1845
|
|
|
|
|
|
|
|
1846
|
0
|
|
|
0
|
|
|
sub _pool { return( shift->_set_get_object( '_pool', 'HTTP::Promise::Pool', @_ ) ); } |
1847
|
|
|
|
|
|
|
|
1848
|
|
|
|
|
|
|
# The purpose of this method is to read the entire HTPP message body, whatever that is, i.e. multipart o not |
1849
|
|
|
|
|
|
|
# Parsing and decoding is done after data has been read from the socket, because speed matters. |
1850
|
|
|
|
|
|
|
sub _read_body |
1851
|
|
|
|
|
|
|
{ |
1852
|
0
|
|
|
0
|
|
|
my $self = shift( @_ ); |
1853
|
0
|
|
|
|
|
|
my $opts = $self->_get_args_as_hash( @_ ); |
1854
|
0
|
|
0
|
|
|
|
my $timeout = $opts->{timeout} // $self->timeout; |
1855
|
0
|
|
|
|
|
|
my $headers = $opts->{headers}; |
1856
|
0
|
0
|
|
|
|
|
return( $self->error( "Headers object provided is not a HTTP::Promise::Headers object." ) ) if( !$self->_is_a( $headers => 'HTTP::Promise::Headers' ) ); |
1857
|
0
|
|
|
|
|
|
my $ent = $opts->{entity}; |
1858
|
0
|
0
|
|
|
|
|
return( $self->error( "Entity object provided is not a HTTP::Promise::Entity object." ) ) if( !$self->_is_a( $ent => 'HTTP::Promise::Entity' ) ); |
1859
|
0
|
|
|
|
|
|
my $reader = $opts->{reader}; |
1860
|
0
|
0
|
|
|
|
|
return( $self->error( "Reader object provided is not a HTTP::Promise::IO object." ) ) if( !$self->_is_a( $reader => 'HTTP::Promise::IO' ) ); |
1861
|
0
|
|
|
|
|
|
my $bufsize = $self->buffer_size; |
1862
|
|
|
|
|
|
|
|
1863
|
0
|
|
|
|
|
|
my $type = $headers->type; |
1864
|
0
|
|
|
|
|
|
my $max_in_memory = $self->max_body_in_memory_size; |
1865
|
|
|
|
|
|
|
# rfc7231, section 3.1.1.5 says we can assume applicatin/octet-stream if there |
1866
|
|
|
|
|
|
|
# is no Content-Type header |
1867
|
|
|
|
|
|
|
# <https://tools.ietf.org/html/rfc7231#section-3.1.1.5> |
1868
|
0
|
|
0
|
|
|
|
my $default_mime = $DEFAULT_MIME_TYPE || 'application/octet-stream'; |
1869
|
0
|
|
|
|
|
|
my $len = $headers->content_length; |
1870
|
0
|
|
|
|
|
|
my $chunk_size = $self->buffer_size; |
1871
|
0
|
|
|
|
|
|
my( $body, $file, $mime_type, $mime, $ext ); |
1872
|
0
|
|
|
|
|
|
my $data = ''; |
1873
|
0
|
|
|
|
|
|
my $total_bytes = 0; |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
my $get_temp_file = sub |
1876
|
|
|
|
|
|
|
{ |
1877
|
|
|
|
|
|
|
# Guessing extension |
1878
|
0
|
|
|
0
|
|
|
$mime_type = $headers->mime_type( $default_mime ); |
1879
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::MIME' ) || return( $self->pass_error ); |
1880
|
0
|
|
|
|
|
|
$mime = HTTP::Promise::MIME->new; |
1881
|
0
|
|
|
|
|
|
$ext = $mime->suffix( $type ); |
1882
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $mime->error ) ) if( !defined( $ext ) ); |
1883
|
0
|
|
0
|
|
|
|
$ext ||= 'dat'; |
1884
|
0
|
|
0
|
|
|
|
my $f = $self->new_tempfile( extension => $ext ) || |
1885
|
|
|
|
|
|
|
return( $self->pass_error ); |
1886
|
0
|
|
|
|
|
|
return( $f ); |
1887
|
0
|
|
|
|
|
|
}; |
1888
|
|
|
|
|
|
|
|
1889
|
0
|
0
|
|
|
|
|
if( defined( $len ) ) |
1890
|
|
|
|
|
|
|
{ |
1891
|
|
|
|
|
|
|
# Too big, saving it to file; or |
1892
|
|
|
|
|
|
|
# use_content_file is set to true. |
1893
|
0
|
0
|
0
|
|
|
|
if( ( $len > $max_in_memory ) || $self->use_content_file ) |
1894
|
|
|
|
|
|
|
{ |
1895
|
0
|
|
0
|
|
|
|
$file = $get_temp_file->() || return( $self->pass_error ); |
1896
|
0
|
|
0
|
|
|
|
my $io = $file->open( '+>', { binmode => 'raw', autoflush => 1 } ) || |
1897
|
|
|
|
|
|
|
return( $self->pass_error( $file->error ) ); |
1898
|
0
|
|
|
|
|
|
my $buff = ''; |
1899
|
0
|
|
|
|
|
|
my $bytes; |
1900
|
0
|
0
|
|
|
|
|
$chunk_size = $len if( $chunk_size > $len ); |
1901
|
0
|
|
|
|
|
|
while( $bytes = $reader->read( $buff, $chunk_size ) ) |
1902
|
|
|
|
|
|
|
{ |
1903
|
0
|
|
|
|
|
|
my $bytes_out = $io->syswrite( $buff ); |
1904
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $io->error ) ) if( !defined( $bytes_out ) ); |
1905
|
|
|
|
|
|
|
# We do not want to read more than we should |
1906
|
0
|
0
|
0
|
|
|
|
$chunk_size = ( $len - $total_bytes ) if( ( $total_bytes < $len ) && ( ( $total_bytes + $chunk_size ) > $len ) ); |
1907
|
0
|
|
|
|
|
|
$total_bytes += $bytes; |
1908
|
0
|
0
|
|
|
|
|
last if( $total_bytes == $len ); |
1909
|
|
|
|
|
|
|
} |
1910
|
0
|
|
|
|
|
|
$io->close; |
1911
|
0
|
0
|
|
|
|
|
return( $self->error( "Error reading http body from socket: ", $reader->error ) ) if( !defined( $bytes ) ); |
1912
|
|
|
|
|
|
|
} |
1913
|
|
|
|
|
|
|
else |
1914
|
|
|
|
|
|
|
{ |
1915
|
0
|
|
|
|
|
|
my $buff = ''; |
1916
|
0
|
|
|
|
|
|
my $bytes; |
1917
|
0
|
0
|
|
|
|
|
$chunk_size = $len if( $chunk_size > $len ); |
1918
|
0
|
|
|
|
|
|
while( $bytes = $reader->read( $buff, $chunk_size ) ) |
1919
|
|
|
|
|
|
|
{ |
1920
|
0
|
|
|
|
|
|
$data .= $buff; |
1921
|
|
|
|
|
|
|
# We do not want to read more than we should |
1922
|
0
|
0
|
0
|
|
|
|
$chunk_size = ( $len - $total_bytes ) if( ( $total_bytes < $len ) && ( ( $total_bytes + $chunk_size ) > $len ) ); |
1923
|
0
|
|
|
|
|
|
$total_bytes += $bytes; |
1924
|
0
|
0
|
|
|
|
|
last if( $total_bytes == $len ); |
1925
|
|
|
|
|
|
|
} |
1926
|
0
|
0
|
|
|
|
|
return( $self->error( "Error reading HTTP body from socket: ", $reader->error ) ) if( !defined( $bytes ) ); |
1927
|
|
|
|
|
|
|
} |
1928
|
0
|
0
|
0
|
|
|
|
warn( "HTTP::Promise: HTTP body size advertised ($len) does not match the size actually read from socket ($total_bytes)\n" ) if( $total_bytes != $len && $self->_warnings_is_enabled ); |
1929
|
|
|
|
|
|
|
} |
1930
|
|
|
|
|
|
|
# No Content-Length defined |
1931
|
|
|
|
|
|
|
else |
1932
|
|
|
|
|
|
|
{ |
1933
|
0
|
|
|
|
|
|
my $buff = ''; |
1934
|
0
|
|
|
|
|
|
my $bytes = -1; |
1935
|
0
|
|
|
|
|
|
my $io; |
1936
|
0
|
|
|
|
|
|
while( $bytes ) |
1937
|
|
|
|
|
|
|
{ |
1938
|
0
|
|
|
|
|
|
$bytes = $reader->read( $buff, $chunk_size ); |
1939
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $reader->error ) ) if( !defined( $bytes ) ); |
1940
|
|
|
|
|
|
|
|
1941
|
0
|
0
|
|
|
|
|
if( defined( $io ) ) |
|
|
0
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
{ |
1943
|
0
|
|
|
|
|
|
my $bytes_out = $io->syswrite( $buff ); |
1944
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $io->error ) ) if( !defined( $bytes_out ) ); |
1945
|
|
|
|
|
|
|
} |
1946
|
|
|
|
|
|
|
# The cumulative bytes total for this part exceeds the allowed maximum in memory |
1947
|
|
|
|
|
|
|
elsif( ( length( $data ) + length( $buff ) ) > $max_in_memory ) |
1948
|
|
|
|
|
|
|
{ |
1949
|
0
|
|
0
|
|
|
|
$file = $get_temp_file->() || return( $self->pass_error ); |
1950
|
0
|
|
0
|
|
|
|
$io = $file->open( '+>', { binmode => 'raw', autoflush => 1 } ) || |
1951
|
|
|
|
|
|
|
return( $self->pass_error( $file->error ) ); |
1952
|
0
|
|
|
|
|
|
my $bytes_out = $io->syswrite( $data ); |
1953
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $io->error ) ) if( !defined( $bytes_out ) ); |
1954
|
0
|
|
|
|
|
|
$bytes_out = $io->syswrite( $buff ); |
1955
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $io->error ) ) if( !defined( $bytes_out ) ); |
1956
|
0
|
|
|
|
|
|
$data = ''; |
1957
|
|
|
|
|
|
|
} |
1958
|
|
|
|
|
|
|
else |
1959
|
|
|
|
|
|
|
{ |
1960
|
0
|
|
|
|
|
|
$data .= $buff; |
1961
|
|
|
|
|
|
|
} |
1962
|
|
|
|
|
|
|
} |
1963
|
0
|
0
|
|
|
|
|
$total_bytes = defined( $file ) ? $file->length : length( $data ); |
1964
|
|
|
|
|
|
|
} |
1965
|
|
|
|
|
|
|
|
1966
|
|
|
|
|
|
|
# If we used a file and the extension is 'dat', because we were clueless based on |
1967
|
|
|
|
|
|
|
# the provided Content-Type, or maybe even the Content-Type is absent, we use the |
1968
|
|
|
|
|
|
|
# XS module in HTTP::Promise::MIME to guess the mime-type based on the actual file |
1969
|
|
|
|
|
|
|
# content |
1970
|
0
|
0
|
|
|
|
|
if( defined( $file ) ) |
1971
|
|
|
|
|
|
|
{ |
1972
|
0
|
0
|
|
|
|
|
if( $mime_type eq $default_mime ) |
1973
|
|
|
|
|
|
|
{ |
1974
|
0
|
0
|
|
|
|
|
unless( $mime ) |
1975
|
|
|
|
|
|
|
{ |
1976
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::MIME' ) || return( $self->pass_error ); |
1977
|
0
|
|
|
|
|
|
$mime = HTTP::Promise::MIME->new; |
1978
|
|
|
|
|
|
|
} |
1979
|
|
|
|
|
|
|
|
1980
|
|
|
|
|
|
|
# Guess the mime type from the file magic |
1981
|
0
|
|
|
|
|
|
my $mtype = $mime->mime_type( $file ); |
1982
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $mime->error ) ) if( !defined( $mime_type ) ); |
1983
|
0
|
|
|
|
|
|
my( $enc, $enc_ext ); |
1984
|
0
|
0
|
0
|
|
|
|
if( $self->ext_vary && ( $enc = $headers->content_encoding ) ) |
1985
|
|
|
|
|
|
|
{ |
1986
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::Stream' ) || return( $self->pass_error ); |
1987
|
0
|
|
0
|
|
|
|
my $enc_exts = HTTP::Promise::Stream->encoding2suffix( $enc ) || |
1988
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Stream->error ) ); |
1989
|
0
|
0
|
|
|
|
|
$enc_ext = $enc_exts->join( '.' )->scalar if( !$enc_exts->is_empty ); |
1990
|
|
|
|
|
|
|
# Mark body as being encoded if necessary |
1991
|
0
|
|
|
|
|
|
$ent->is_encoded(1); |
1992
|
|
|
|
|
|
|
} |
1993
|
0
|
0
|
0
|
|
|
|
if( $mtype && $mtype ne $default_mime ) |
|
|
0
|
|
|
|
|
|
1994
|
|
|
|
|
|
|
{ |
1995
|
0
|
|
|
|
|
|
$mime_type = $mtype; |
1996
|
|
|
|
|
|
|
# Also update the type value in HTTP::Promise::Headers |
1997
|
|
|
|
|
|
|
# It does not affect the actual Content-Type header |
1998
|
0
|
|
|
|
|
|
$headers->type( $mtype ); |
1999
|
0
|
|
|
|
|
|
my $new_ext = $mime->suffix( $mtype ); |
2000
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $mime->error ) ) if( !defined( $new_ext ) ); |
2001
|
0
|
0
|
0
|
|
|
|
if( $new_ext && $new_ext ne $ext ) |
2002
|
|
|
|
|
|
|
{ |
2003
|
0
|
0
|
|
|
|
|
$new_ext .= ".${enc_ext}" if( defined( $enc_ext ) ); |
2004
|
0
|
|
0
|
|
|
|
my $new_file = $file->extension( $new_ext ) || return( $self->pass_error( $file->error ) ); |
2005
|
0
|
|
0
|
|
|
|
my $this_file = $file->move( $new_file ) || return( $self->pass_error( $file->error ) ); |
2006
|
0
|
|
|
|
|
|
$file = $this_file; |
2007
|
|
|
|
|
|
|
} |
2008
|
|
|
|
|
|
|
} |
2009
|
|
|
|
|
|
|
elsif( defined( $enc_ext ) ) |
2010
|
|
|
|
|
|
|
{ |
2011
|
0
|
|
|
|
|
|
my $old_ext = $file->extension; |
2012
|
0
|
|
|
|
|
|
$old_ext .= ".${enc_ext}"; |
2013
|
0
|
|
0
|
|
|
|
my $new_file = $file->extension( $old_ext ) || return( $self->pass_error( $file->error ) ); |
2014
|
0
|
|
0
|
|
|
|
my $this_file = $file->move( $new_file ) || return( $self->pass_error( $file->error ) ); |
2015
|
0
|
|
|
|
|
|
$file = $this_file; |
2016
|
|
|
|
|
|
|
} |
2017
|
|
|
|
|
|
|
} |
2018
|
|
|
|
|
|
|
else |
2019
|
|
|
|
|
|
|
{ |
2020
|
0
|
|
|
|
|
|
my( $enc ); |
2021
|
0
|
0
|
0
|
|
|
|
if( $self->ext_vary && ( $enc = $headers->content_encoding ) ) |
2022
|
|
|
|
|
|
|
{ |
2023
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::Stream' ) || return( $self->pass_error ); |
2024
|
0
|
|
|
|
|
|
my $old_ext = $file->extension; |
2025
|
0
|
|
0
|
|
|
|
my $enc_exts = HTTP::Promise::Stream->encoding2suffix( $enc ) || |
2026
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Stream->error ) ); |
2027
|
0
|
0
|
|
|
|
|
if( !$enc_exts->is_empty ) |
2028
|
|
|
|
|
|
|
{ |
2029
|
0
|
|
|
|
|
|
$old_ext .= '.' . $enc_exts->join( '.' )->scalar; |
2030
|
0
|
|
0
|
|
|
|
my $new_file = $file->extension( $old_ext ) || return( $self->pass_error( $file->error ) ); |
2031
|
0
|
|
0
|
|
|
|
my $this_file = $file->move( $new_file ) || return( $self->pass_error( $file->error ) ); |
2032
|
0
|
|
|
|
|
|
$file = $this_file; |
2033
|
|
|
|
|
|
|
} |
2034
|
|
|
|
|
|
|
# Mark body as being encoded if necessary |
2035
|
0
|
|
|
|
|
|
$ent->is_encoded(1); |
2036
|
|
|
|
|
|
|
} |
2037
|
|
|
|
|
|
|
} |
2038
|
|
|
|
|
|
|
|
2039
|
0
|
|
0
|
|
|
|
$body = $ent->new_body( file => $file ) || |
2040
|
|
|
|
|
|
|
return( $self->pass_error( $ent->error ) ); |
2041
|
|
|
|
|
|
|
} |
2042
|
|
|
|
|
|
|
# in memory |
2043
|
|
|
|
|
|
|
else |
2044
|
|
|
|
|
|
|
{ |
2045
|
|
|
|
|
|
|
# If this is a application/x-www-form-urlencoded type, we save it as such, and |
2046
|
|
|
|
|
|
|
# the HTTP::Promise::Body::Form makes those data accessible as an hash object |
2047
|
0
|
0
|
|
|
|
|
if( $type eq TYPE_URL_ENCODED ) |
2048
|
|
|
|
|
|
|
{ |
2049
|
0
|
|
0
|
|
|
|
$body = $ent->new_body( form => $data ) || |
2050
|
|
|
|
|
|
|
return( $self->pass_error( $ent->error ) ); |
2051
|
|
|
|
|
|
|
} |
2052
|
|
|
|
|
|
|
else |
2053
|
|
|
|
|
|
|
{ |
2054
|
0
|
|
0
|
|
|
|
$body = $ent->new_body( string => $data ) || |
2055
|
|
|
|
|
|
|
return( $self->pass_error( $ent->error ) ); |
2056
|
|
|
|
|
|
|
} |
2057
|
|
|
|
|
|
|
} |
2058
|
0
|
|
|
|
|
|
return( $body ); |
2059
|
|
|
|
|
|
|
} |
2060
|
|
|
|
|
|
|
|
2061
|
|
|
|
|
|
|
sub _read_body_chunked |
2062
|
|
|
|
|
|
|
{ |
2063
|
0
|
|
|
0
|
|
|
my $self = shift( @_ ); |
2064
|
0
|
|
|
|
|
|
my $opts = $self->_get_args_as_hash( @_ ); |
2065
|
0
|
|
0
|
|
|
|
my $timeout = $opts->{timeout} // $self->timeout; |
2066
|
0
|
|
|
|
|
|
my $headers = $opts->{headers}; |
2067
|
0
|
0
|
|
|
|
|
return( $self->error( "Headers object provided is not a HTTP::Promise::Headers object." ) ) if( !$self->_is_a( $headers => 'HTTP::Promise::Headers' ) ); |
2068
|
0
|
|
|
|
|
|
my $ent = $opts->{entity}; |
2069
|
0
|
0
|
|
|
|
|
return( $self->error( "Entity object provided is not a HTTP::Promise::Entity object." ) ) if( !$self->_is_a( $ent => 'HTTP::Promise::Entity' ) ); |
2070
|
0
|
|
|
|
|
|
my $reader = $opts->{reader}; |
2071
|
0
|
0
|
|
|
|
|
return( $self->error( "Reader object provided is not a HTTP::Promise::IO object." ) ) if( !$self->_is_a( $reader => 'HTTP::Promise::IO' ) ); |
2072
|
0
|
|
|
|
|
|
my $bufsize = $self->buffer_size; |
2073
|
|
|
|
|
|
|
# rfc7231, section 3.1.1.5 says we can assume applicatin/octet-stream if there |
2074
|
|
|
|
|
|
|
# is no Content-Type header |
2075
|
|
|
|
|
|
|
# <https://tools.ietf.org/html/rfc7231#section-3.1.1.5> |
2076
|
0
|
|
0
|
|
|
|
my $default_mime = $DEFAULT_MIME_TYPE || 'application/octet-stream'; |
2077
|
0
|
|
|
|
|
|
my $len = $headers->content_length; |
2078
|
|
|
|
|
|
|
|
2079
|
|
|
|
|
|
|
# Guessing extension |
2080
|
0
|
|
|
|
|
|
my $mime_type = $headers->mime_type( $default_mime ); |
2081
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::MIME' ) || return( $self->pass_error ); |
2082
|
0
|
|
|
|
|
|
my $mime = HTTP::Promise::MIME->new; |
2083
|
0
|
|
|
|
|
|
my $ext = $mime->suffix( $mime_type ); |
2084
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $mime->error ) ) if( !defined( $ext ) ); |
2085
|
0
|
|
0
|
|
|
|
$ext ||= 'dat'; |
2086
|
0
|
|
|
|
|
|
my $enc; |
2087
|
0
|
0
|
0
|
|
|
|
if( $self->ext_vary && ( $enc = $headers->content_encoding ) ) |
2088
|
|
|
|
|
|
|
{ |
2089
|
0
|
0
|
|
|
|
|
$self->_load_class( 'HTTP::Promise::Stream' ) || return( $self->pass_error ); |
2090
|
0
|
|
0
|
|
|
|
my $enc_ext = HTTP::Promise::Stream->encoding2suffix( $enc ) || |
2091
|
|
|
|
|
|
|
return( $self->pass_error( HTTP::Promise::Stream->error ) ); |
2092
|
0
|
0
|
|
|
|
|
$ext .= '.' . $enc_ext->join( '.' )->scalar if( !$enc_ext->is_empty ); |
2093
|
|
|
|
|
|
|
} |
2094
|
0
|
|
0
|
|
|
|
my $tempfile = $self->new_tempfile( extension => $ext ) || |
2095
|
|
|
|
|
|
|
return( $self->pass_error ); |
2096
|
|
|
|
|
|
|
# HTTP::Promise::Body::File inherits from Module::Generic::File, so we pass it some |
2097
|
|
|
|
|
|
|
# appropriate parameters. |
2098
|
0
|
|
0
|
|
|
|
my $body = $ent->new_body( 'file', $tempfile ) || |
2099
|
|
|
|
|
|
|
return( $self->pass_error( $ent->error ) ); |
2100
|
0
|
|
0
|
|
|
|
my $io = $body->open( '+>', { binmode => 'raw', autoflush => 1 } ) || |
2101
|
|
|
|
|
|
|
return( $self->pass_error( $body->error ) ); |
2102
|
0
|
|
|
|
|
|
my $buff = ''; |
2103
|
0
|
|
|
|
|
|
my $bytes = -1; |
2104
|
0
|
|
|
|
|
|
my $te_re = qr{ |
2105
|
|
|
|
|
|
|
\A ( # header |
2106
|
|
|
|
|
|
|
( [0-9a-fA-F]+ ) # next_len (hex number) |
2107
|
|
|
|
|
|
|
(?:; |
2108
|
|
|
|
|
|
|
$HTTP_TOKEN |
2109
|
|
|
|
|
|
|
= |
2110
|
|
|
|
|
|
|
(?: $HTTP_TOKEN | $HTTP_QUOTED_STRING ) |
2111
|
|
|
|
|
|
|
)* # optional chunk-extensions |
2112
|
|
|
|
|
|
|
[[:blank:]]* # www.yahoo.com adds spaces here. |
2113
|
|
|
|
|
|
|
# Is this valid? |
2114
|
|
|
|
|
|
|
\015\012 # CR+LF |
2115
|
|
|
|
|
|
|
) |
2116
|
|
|
|
|
|
|
}mxs; |
2117
|
|
|
|
|
|
|
|
2118
|
0
|
|
|
|
|
|
READ_LOOP: while( $bytes ) |
2119
|
|
|
|
|
|
|
{ |
2120
|
|
|
|
|
|
|
# If we do not find anything within the maximum allocable memory size, this will |
2121
|
|
|
|
|
|
|
# return an error, so we can bank on it |
2122
|
0
|
|
|
|
|
|
my $hdr = $reader->read_until_in_memory( $te_re, include => 1 ); |
2123
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $reader->error ) ) if( !defined( $hdr ) ); |
2124
|
0
|
0
|
|
|
|
|
last if( !length( $hdr ) ); |
2125
|
|
|
|
|
|
|
|
2126
|
0
|
|
|
|
|
|
my( $header, $hex_len ) = ( $hdr =~ m/$te_re/ ); |
2127
|
|
|
|
|
|
|
# remove header from buffer |
2128
|
|
|
|
|
|
|
# $hdr = substr( $hdr, 0, length( $header ), '' ); |
2129
|
0
|
|
|
|
|
|
my $len = hex( $hex_len ); |
2130
|
0
|
0
|
|
|
|
|
if( $len == 0 ) |
2131
|
|
|
|
|
|
|
{ |
2132
|
0
|
|
|
|
|
|
last READ_LOOP; |
2133
|
|
|
|
|
|
|
} |
2134
|
|
|
|
|
|
|
# $reader->unread( $hdr ) if( length( $hdr ) ); |
2135
|
|
|
|
|
|
|
|
2136
|
0
|
|
|
|
|
|
my $chunk_size = $bufsize; |
2137
|
0
|
0
|
|
|
|
|
$chunk_size = $len if( $chunk_size > $len ); |
2138
|
0
|
|
|
|
|
|
my $total_bytes = 0; |
2139
|
0
|
|
|
|
|
|
READ_CHUNK: while( $bytes = $reader->read( $buff, $chunk_size ) ) |
2140
|
|
|
|
|
|
|
{ |
2141
|
0
|
0
|
|
|
|
|
if( $ent->is_binary( $buff ) ) |
2142
|
|
|
|
|
|
|
{ |
2143
|
0
|
0
|
|
|
|
|
if( -t( STDIN ) ) |
2144
|
|
|
|
|
|
|
{ |
2145
|
0
|
|
|
|
|
|
$self->message_colour( 5, '<green>[' . length( $buff ) . ' bytes of binary data not shown here]</>', { prefix => '<<<' } ); |
2146
|
|
|
|
|
|
|
} |
2147
|
|
|
|
|
|
|
else |
2148
|
|
|
|
|
|
|
{ |
2149
|
0
|
|
|
|
|
|
$self->message_colour( 5, '[' . length( $buff ) . ' bytes of binary data not shown here]', { prefix => '<<<' } ); |
2150
|
|
|
|
|
|
|
} |
2151
|
|
|
|
|
|
|
} |
2152
|
|
|
|
|
|
|
else |
2153
|
|
|
|
|
|
|
{ |
2154
|
|
|
|
|
|
|
} |
2155
|
|
|
|
|
|
|
|
2156
|
0
|
|
|
|
|
|
my $bytes_out = $io->syswrite( $buff ); |
2157
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $io->error ) ) if( !defined( $bytes_out ) ); |
2158
|
|
|
|
|
|
|
|
2159
|
0
|
0
|
|
|
|
|
if( $bytes_out != $bytes ) |
2160
|
|
|
|
|
|
|
{ |
2161
|
0
|
|
|
|
|
|
return( $self->error( "Error writing to body $body: bytes read ($bytes) do not equate to bytes writen ($bytes_out)" ) ); |
2162
|
|
|
|
|
|
|
} |
2163
|
0
|
|
|
|
|
|
$total_bytes += $bytes; |
2164
|
0
|
0
|
|
|
|
|
last READ_CHUNK if( $total_bytes == $len ); |
2165
|
|
|
|
|
|
|
# We do not want to read more than we should |
2166
|
0
|
0
|
0
|
|
|
|
$chunk_size = ( $len - $total_bytes ) if( ( $total_bytes < $len ) && ( ( $total_bytes + $chunk_size ) > $len ) ); |
2167
|
|
|
|
|
|
|
} |
2168
|
0
|
0
|
|
|
|
|
return( $self->error( "Error reading http body from socket: ", $reader->error ) ) if( !defined( $bytes ) ); |
2169
|
|
|
|
|
|
|
# consume the trailing CRLF sequence |
2170
|
0
|
|
|
|
|
|
my $trash = $reader->read_until_in_memory( qr/${CRLF}/, include => 1 ); |
2171
|
0
|
0
|
|
|
|
|
return( $self->pass_error( $reader->error ) ) if( !defined( $trash ) ); |
2172
|
|
|
|
|
|
|
} |
2173
|
0
|
|
|
|
|
|
$io->close; |
2174
|
|
|
|
|
|
|
# consume the final CRLF sequence |
2175
|
0
|
|
|
|
|
|
my $trash = $reader->read_until_in_memory( qr/${CRLF}/, include => 1 ); |
2176
|
|
|
|
|
|
|
# Mark body as being encoded if necessary |
2177
|
0
|
0
|
0
|
|
|
|
$ent->is_encoded( ( defined( $enc ) && CORE::length( $enc ) ) ? 1 : 0 ); |
2178
|
0
|
|
|
|
|
|
return( $body ); |
2179
|
|
|
|
|
|
|
} |
2180
|
|
|
|
|
|
|
|
2181
|
|
|
|
|
|
|
# NOTE: sub FREEZE is inherited |
2182
|
|
|
|
|
|
|
|
2183
|
0
|
|
|
0
|
0
|
|
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); } |
2184
|
|
|
|
|
|
|
|
2185
|
0
|
|
|
0
|
0
|
|
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); } |
2186
|
|
|
|
|
|
|
|
2187
|
|
|
|
|
|
|
# NOTE: sub THAW is inherited |
2188
|
|
|
|
|
|
|
|
2189
|
|
|
|
|
|
|
1; |
2190
|
|
|
|
|
|
|
# NOTE: POD |
2191
|
|
|
|
|
|
|
__END__ |
2192
|
|
|
|
|
|
|
|
2193
|
|
|
|
|
|
|
=encoding utf-8 |
2194
|
|
|
|
|
|
|
|
2195
|
|
|
|
|
|
|
=head1 NAME |
2196
|
|
|
|
|
|
|
|
2197
|
|
|
|
|
|
|
HTTP::Promise - Asynchronous HTTP Request and Promise |
2198
|
|
|
|
|
|
|
|
2199
|
|
|
|
|
|
|
=head1 SYNOPSIS |
2200
|
|
|
|
|
|
|
|
2201
|
|
|
|
|
|
|
use HTTP::Promise; |
2202
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( |
2203
|
|
|
|
|
|
|
agent => 'MyBot/1.0' |
2204
|
|
|
|
|
|
|
accept_encoding => 'auto', # set to 'none' to disable receiving compressed data |
2205
|
|
|
|
|
|
|
accept_language => [qw( fr-FR fr en-GB en ja-JP )], |
2206
|
|
|
|
|
|
|
auto_switch_https => 1, |
2207
|
|
|
|
|
|
|
# For example, a Cookie::Jar object |
2208
|
|
|
|
|
|
|
cookie_jar => $cookie_jar, |
2209
|
|
|
|
|
|
|
dnt => 1, |
2210
|
|
|
|
|
|
|
# 2Mb. Any data to be sent being bigger than this will trigger a Continue conditional query |
2211
|
|
|
|
|
|
|
expect_threshold => 2048000, |
2212
|
|
|
|
|
|
|
# Have the file extension reflect the encoding, if any |
2213
|
|
|
|
|
|
|
ext_vary => 1, |
2214
|
|
|
|
|
|
|
# 100Kb. Anything bigger than this will be automatically saved on file rather than memory |
2215
|
|
|
|
|
|
|
max_body_in_memory_size => 102400, |
2216
|
|
|
|
|
|
|
# 8Kb |
2217
|
|
|
|
|
|
|
max_headers_size => 8192, |
2218
|
|
|
|
|
|
|
max_redirect => 3, |
2219
|
|
|
|
|
|
|
# For Promise::Me |
2220
|
|
|
|
|
|
|
medium => 'mmap', |
2221
|
|
|
|
|
|
|
proxy => 'https://proxy.example.org:8080', |
2222
|
|
|
|
|
|
|
# The serialiser to use for the promise in Promise::Me |
2223
|
|
|
|
|
|
|
# Defaults to storable, but can also be cbor and sereal |
2224
|
|
|
|
|
|
|
serialiser => 'sereal', |
2225
|
|
|
|
|
|
|
shared_mem_size => 1048576, |
2226
|
|
|
|
|
|
|
# You can also use decimals with Time::HiRes |
2227
|
|
|
|
|
|
|
timeout => 15, |
2228
|
|
|
|
|
|
|
# force the use of files to store the response content |
2229
|
|
|
|
|
|
|
use_content_file => 1, |
2230
|
|
|
|
|
|
|
# Should we use promise? |
2231
|
|
|
|
|
|
|
# use_promise => 0, |
2232
|
|
|
|
|
|
|
); |
2233
|
|
|
|
|
|
|
my $prom = $p->get( 'https://www.example.org', $hash_of_query_params )->then(sub |
2234
|
|
|
|
|
|
|
{ |
2235
|
|
|
|
|
|
|
# Nota bene: the last value in this sub will be passed as the argument to the next 'then' |
2236
|
|
|
|
|
|
|
my $resp = shift( @_ ); # get the HTTP::Promise::Response object |
2237
|
|
|
|
|
|
|
})->catch(sub |
2238
|
|
|
|
|
|
|
{ |
2239
|
|
|
|
|
|
|
my $ex = shift( @_ ); # get a HTTP::Promise::Exception object |
2240
|
|
|
|
|
|
|
say "Exception code is: ", $ex->code; |
2241
|
|
|
|
|
|
|
}); |
2242
|
|
|
|
|
|
|
# or using hash reference of options to prepare the request |
2243
|
|
|
|
|
|
|
my $req = HTTP::Promise::Request->new( get => 'https://www.example.org' ) || |
2244
|
|
|
|
|
|
|
die( HTTP::Promise::Request->error ); |
2245
|
|
|
|
|
|
|
my $prom = $p->request( $req )->then(sub{ #... })->catch(sub{ # ... }); |
2246
|
|
|
|
|
|
|
|
2247
|
|
|
|
|
|
|
=head1 VERSION |
2248
|
|
|
|
|
|
|
|
2249
|
|
|
|
|
|
|
v0.3.3 |
2250
|
|
|
|
|
|
|
|
2251
|
|
|
|
|
|
|
=head1 DESCRIPTION |
2252
|
|
|
|
|
|
|
|
2253
|
|
|
|
|
|
|
L<HTTP::Promise> provides with a fast and powerful yet memory-friendly API to make true asynchronous HTTP requests using fork with L<Promise::Me>. |
2254
|
|
|
|
|
|
|
|
2255
|
|
|
|
|
|
|
It is based on the design of L<HTTP::Message>, but with a much cleaner interface to make requests and manage HTTP entity bodies. |
2256
|
|
|
|
|
|
|
|
2257
|
|
|
|
|
|
|
Here are the key features: |
2258
|
|
|
|
|
|
|
|
2259
|
|
|
|
|
|
|
=over 4 |
2260
|
|
|
|
|
|
|
|
2261
|
|
|
|
|
|
|
=item * Support for HTTP/1.0 and HTTP/1.1 |
2262
|
|
|
|
|
|
|
|
2263
|
|
|
|
|
|
|
=item * Handles gracefully very large files by reading and sending them in chunks. |
2264
|
|
|
|
|
|
|
|
2265
|
|
|
|
|
|
|
=item * Supports C<Continue> conditional requests |
2266
|
|
|
|
|
|
|
|
2267
|
|
|
|
|
|
|
=item * Support redirects |
2268
|
|
|
|
|
|
|
|
2269
|
|
|
|
|
|
|
=item * Reads data in chunks of bytes and not line by line. |
2270
|
|
|
|
|
|
|
|
2271
|
|
|
|
|
|
|
=item * Easy-to-use interface to encode and decode with L<HTTP::Promise::Stream> |
2272
|
|
|
|
|
|
|
|
2273
|
|
|
|
|
|
|
=item * Multi-lingual and complete HTTP Status codes with L<HTTP::Promise::Status> |
2274
|
|
|
|
|
|
|
|
2275
|
|
|
|
|
|
|
=item * MIME guessing module with L<HTTP::Promise::MIME> |
2276
|
|
|
|
|
|
|
|
2277
|
|
|
|
|
|
|
=item * Powerful HTTP parser with L<HTTP::Promise::Parser> supporting complex C<multipart> HTTP messages. |
2278
|
|
|
|
|
|
|
|
2279
|
|
|
|
|
|
|
=item * Has thorough documentation |
2280
|
|
|
|
|
|
|
|
2281
|
|
|
|
|
|
|
=back |
2282
|
|
|
|
|
|
|
|
2283
|
|
|
|
|
|
|
Here is how it is organised in overall: |
2284
|
|
|
|
|
|
|
|
2285
|
|
|
|
|
|
|
+-------------------------+ +--------------------------+ |
2286
|
|
|
|
|
|
|
| | | | |
2287
|
|
|
|
|
|
|
| HTTP::Promise::Request | | HTTP::Promise::Response | |
2288
|
|
|
|
|
|
|
| | | | |
2289
|
|
|
|
|
|
|
+------------|------------+ +-------------|------------+ |
2290
|
|
|
|
|
|
|
| | |
2291
|
|
|
|
|
|
|
| | |
2292
|
|
|
|
|
|
|
| | |
2293
|
|
|
|
|
|
|
| +------------------------+ | |
2294
|
|
|
|
|
|
|
| | | | |
2295
|
|
|
|
|
|
|
+--- HTTP::Promise::Message |---+ |
2296
|
|
|
|
|
|
|
| | |
2297
|
|
|
|
|
|
|
+------------|-----------+ |
2298
|
|
|
|
|
|
|
| |
2299
|
|
|
|
|
|
|
| |
2300
|
|
|
|
|
|
|
+------------|-----------+ |
2301
|
|
|
|
|
|
|
| | |
2302
|
|
|
|
|
|
|
| HTTP::Promise::Entity | |
2303
|
|
|
|
|
|
|
| | |
2304
|
|
|
|
|
|
|
+------------|-----------+ |
2305
|
|
|
|
|
|
|
| |
2306
|
|
|
|
|
|
|
| |
2307
|
|
|
|
|
|
|
+------------|-----------+ |
2308
|
|
|
|
|
|
|
| | |
2309
|
|
|
|
|
|
|
| HTTP::Promise::Body | |
2310
|
|
|
|
|
|
|
| | |
2311
|
|
|
|
|
|
|
+------------------------+ |
2312
|
|
|
|
|
|
|
|
2313
|
|
|
|
|
|
|
It differentiates from other modules by using several XS modules for speed, and has a notion of HTTP L<entity|HTTP::Promise::Entity> and L<body|HTTP::Promise::Body> stored either on file or in memory. |
2314
|
|
|
|
|
|
|
|
2315
|
|
|
|
|
|
|
It also has modules to make it really super easy to create C<x-www-form-urlencoded> requests with L<HTTP::Promise::Body::Form>, or C<multipart> ones with L<HTTP::Promise::Body::Form::Data> |
2316
|
|
|
|
|
|
|
|
2317
|
|
|
|
|
|
|
Thus, you can either have a fine granularity by creating your own request using L<HTTP::Promise::Request>, or you can use the high level methods provided by L<HTTP::Promise>, which are: L</delete>, L</get>, L</head>, L</options>, L</patch>, L</post>, L</put> and each will occur asynchronously. |
2318
|
|
|
|
|
|
|
|
2319
|
|
|
|
|
|
|
Each of those methods returns a L<promise|Promise::Me>, which means you can chain the results using a chainable L<then|Promise::Me/then> and L<catch|Promise::Me/catch> for errors. |
2320
|
|
|
|
|
|
|
|
2321
|
|
|
|
|
|
|
You can also wait for all of them to finish using L<await|Promise::Me/await>, which is exported by default by L<HTTP::Promise> and L<all|Promise::Me/all> or L<race|Promise::Me/|race>. |
2322
|
|
|
|
|
|
|
|
2323
|
|
|
|
|
|
|
my @results = await( $p1, $p2 ); |
2324
|
|
|
|
|
|
|
my @results = HTTP::Promise->all( $p1, $p2 ); |
2325
|
|
|
|
|
|
|
# First promise that is resolved or rejected makes this super promise resolved and |
2326
|
|
|
|
|
|
|
# return the result |
2327
|
|
|
|
|
|
|
my @results = HTTP::Promise->race( $p1, $p2 ); |
2328
|
|
|
|
|
|
|
|
2329
|
|
|
|
|
|
|
You can also share variables using C<share>, such as: |
2330
|
|
|
|
|
|
|
|
2331
|
|
|
|
|
|
|
my $data : shared = {}; |
2332
|
|
|
|
|
|
|
# or |
2333
|
|
|
|
|
|
|
my( $name, @first_names, %preferences ); |
2334
|
|
|
|
|
|
|
share( $name, @first_names, %preferences ); |
2335
|
|
|
|
|
|
|
|
2336
|
|
|
|
|
|
|
See L<Promise::Me> for more information. |
2337
|
|
|
|
|
|
|
|
2338
|
|
|
|
|
|
|
It calls L<resolve|Promise::Me/resolve> when the request has been completed and sends a L<HTTP::Promise::Response> object whose API is similar to that of L<HTTP::Response>. |
2339
|
|
|
|
|
|
|
|
2340
|
|
|
|
|
|
|
When an error occurs, it is caught and sent by calling L<Promise::Me/reject> with an L<HTTP::Promise::Exception> object. |
2341
|
|
|
|
|
|
|
|
2342
|
|
|
|
|
|
|
Cookies are automatically and transparently managed with L<Cookie::Jar> which can load and store cookies to a json file you specify. You can create a L<cookie object|Cookie::Jar> and pass it to the constructor with the C<cookie_jar> option. |
2343
|
|
|
|
|
|
|
|
2344
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
2345
|
|
|
|
|
|
|
|
2346
|
|
|
|
|
|
|
=head2 new |
2347
|
|
|
|
|
|
|
|
2348
|
|
|
|
|
|
|
Provided with some optional parameters, and this instantiates a new L<HTTP::Promise> objects and returns it. If an error occurred, it will return C<undef> and the error can be retrieved using L<error|Module::Generic/error> method. |
2349
|
|
|
|
|
|
|
|
2350
|
|
|
|
|
|
|
It accepts the following parameters. Each of those options have a corresponding method, so you can get or change its value later: |
2351
|
|
|
|
|
|
|
|
2352
|
|
|
|
|
|
|
=over 4 |
2353
|
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
|
=item * C<accept_encoding> |
2355
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
String. This sets whether we should accept compressed data. |
2357
|
|
|
|
|
|
|
|
2358
|
|
|
|
|
|
|
You can set it to C<none> to disable it. By default, this is C<auto>, and it will set the C<Accept-Encoding> C<HTTP> header to all the supported encoding based on the availability of associated modules. |
2359
|
|
|
|
|
|
|
|
2360
|
|
|
|
|
|
|
You can also set this to a comma-separated list of known encoding, typically: C<bzip2,deflate,gzip,rawdeflate,brotli> |
2361
|
|
|
|
|
|
|
|
2362
|
|
|
|
|
|
|
See L<HTTP::Promise::Stream> for more details. |
2363
|
|
|
|
|
|
|
|
2364
|
|
|
|
|
|
|
=item * C<agent> |
2365
|
|
|
|
|
|
|
|
2366
|
|
|
|
|
|
|
String. Set the user agent, i.e. the way this interface identifies itself when communicating with an HTTP server. By default, it uses something like C<HTTP-Promise/v0.1.0> |
2367
|
|
|
|
|
|
|
|
2368
|
|
|
|
|
|
|
=item * C<cookie_jar> |
2369
|
|
|
|
|
|
|
|
2370
|
|
|
|
|
|
|
Object. Set the class handling the cookie jar. By default it uses L<Cookie::Jar> |
2371
|
|
|
|
|
|
|
|
2372
|
|
|
|
|
|
|
=item * C<default_headers> |
2373
|
|
|
|
|
|
|
|
2374
|
|
|
|
|
|
|
L<HTTP::Promise::Headers>, or L<HTTP::Headers> Object. Sets the headers object containing the default headers to use. |
2375
|
|
|
|
|
|
|
|
2376
|
|
|
|
|
|
|
=item * C<local_address> |
2377
|
|
|
|
|
|
|
|
2378
|
|
|
|
|
|
|
String. A local IP address or local host name to use when establishing TCP/IP connections. |
2379
|
|
|
|
|
|
|
|
2380
|
|
|
|
|
|
|
=item * C<local_host> |
2381
|
|
|
|
|
|
|
|
2382
|
|
|
|
|
|
|
String. Same as C<local_address> |
2383
|
|
|
|
|
|
|
|
2384
|
|
|
|
|
|
|
=item * C<local_port> |
2385
|
|
|
|
|
|
|
|
2386
|
|
|
|
|
|
|
Integer. A local port to use when establishing TCP/IP connections. |
2387
|
|
|
|
|
|
|
|
2388
|
|
|
|
|
|
|
=item * C<max_redirect> |
2389
|
|
|
|
|
|
|
|
2390
|
|
|
|
|
|
|
Integer. This is the maximum number of redirect L<HTTP::Promise> will follow until it gives up. Default value is C<7> |
2391
|
|
|
|
|
|
|
|
2392
|
|
|
|
|
|
|
=item * C<max_size> |
2393
|
|
|
|
|
|
|
|
2394
|
|
|
|
|
|
|
Integer. Set the size limit for response content. If the response content exceeds the value set here, the request will be aborted and a C<Client-Aborted> header will be added to the response object returned. Default value is C<undef>, i.e. no limit. |
2395
|
|
|
|
|
|
|
|
2396
|
|
|
|
|
|
|
See also the C<threshold> option. |
2397
|
|
|
|
|
|
|
|
2398
|
|
|
|
|
|
|
=item * C<medium> |
2399
|
|
|
|
|
|
|
|
2400
|
|
|
|
|
|
|
This can be either C<file>, C<mmap> or C<memory>. This will be passed on to L<Promise::Me> as C<result_shared_mem_size> to store resulting data between processes. See L<Promise::Me> for more details. |
2401
|
|
|
|
|
|
|
|
2402
|
|
|
|
|
|
|
It defaults to C<$Promise::Me::SHARE_MEDIUM> |
2403
|
|
|
|
|
|
|
|
2404
|
|
|
|
|
|
|
=item * C<no_proxy> |
2405
|
|
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
Array reference. Do not proxy requests to the given domains. |
2407
|
|
|
|
|
|
|
|
2408
|
|
|
|
|
|
|
=item * C<proxy> |
2409
|
|
|
|
|
|
|
|
2410
|
|
|
|
|
|
|
The url of the proxy to use for the HTTP requests. |
2411
|
|
|
|
|
|
|
|
2412
|
|
|
|
|
|
|
=item * C<requests_redirectable> |
2413
|
|
|
|
|
|
|
|
2414
|
|
|
|
|
|
|
Array reference. This sets the list of http methods that are allowed to be redirected. Default to empty, which means that all methods can be redirected. |
2415
|
|
|
|
|
|
|
|
2416
|
|
|
|
|
|
|
=item * C<serialiser> |
2417
|
|
|
|
|
|
|
|
2418
|
|
|
|
|
|
|
String. Specify the serialiser to use for L<Promise::Me>. Possible values are: L<cbor|CBOR::XS>, L<sereal|Sereal> or L<storable|Storable::Improved> |
2419
|
|
|
|
|
|
|
|
2420
|
|
|
|
|
|
|
By default it uses the value set in the global variable C<$SERIALISER>, which is a copy of the C<$SERIALISER> in L<Promise::Me>, which should be by default C<storable> |
2421
|
|
|
|
|
|
|
|
2422
|
|
|
|
|
|
|
=item * C<shared_mem_size> |
2423
|
|
|
|
|
|
|
|
2424
|
|
|
|
|
|
|
Integer. This will be passed on to L<Promise::Me>. See L<Promise::Me> for more details. |
2425
|
|
|
|
|
|
|
|
2426
|
|
|
|
|
|
|
It defaults to C<$Promise::Me::RESULT_MEMORY_SIZE> |
2427
|
|
|
|
|
|
|
|
2428
|
|
|
|
|
|
|
=item * C<ssl_opts> |
2429
|
|
|
|
|
|
|
|
2430
|
|
|
|
|
|
|
Hash reference. Sets an hash reference of ssl options. The default values are set as follows: |
2431
|
|
|
|
|
|
|
|
2432
|
|
|
|
|
|
|
=over 8 |
2433
|
|
|
|
|
|
|
|
2434
|
|
|
|
|
|
|
=item 1. C<verify_hostname> |
2435
|
|
|
|
|
|
|
|
2436
|
|
|
|
|
|
|
When enabled, this ensures it connects to servers that have a valid certificate matching the expected hostname. |
2437
|
|
|
|
|
|
|
|
2438
|
|
|
|
|
|
|
=over 12 |
2439
|
|
|
|
|
|
|
|
2440
|
|
|
|
|
|
|
=item 1.1. If environment variable C<PERL_LWP_SSL_VERIFY_HOSTNAME> is set, the ssl option property C<verify_hostname> takes its value. |
2441
|
|
|
|
|
|
|
|
2442
|
|
|
|
|
|
|
=item 1.2. If environment variable C<HTTPS_CA_FILE> or C<HTTPS_CA_DIR> are set to a true value, then the ssl option property C<verify_hostname> is set to C<0> and option property C<SSL_verify_mode> is set to C<1> |
2443
|
|
|
|
|
|
|
|
2444
|
|
|
|
|
|
|
=item 1.3 If none of the above applies, it defaults C<verify_hostname> to C<1> |
2445
|
|
|
|
|
|
|
|
2446
|
|
|
|
|
|
|
=back |
2447
|
|
|
|
|
|
|
|
2448
|
|
|
|
|
|
|
=item 2. C<SSL_ca_file> |
2449
|
|
|
|
|
|
|
|
2450
|
|
|
|
|
|
|
This is the path to a file containing the Certificate Authority certificates. |
2451
|
|
|
|
|
|
|
|
2452
|
|
|
|
|
|
|
If environment variable C<PERL_LWP_SSL_CA_FILE> or C<HTTPS_CA_FILE> is set, then the ssl option property C<SSL_ca_file> takes its value. |
2453
|
|
|
|
|
|
|
|
2454
|
|
|
|
|
|
|
=item 3. C<SSL_ca_path> |
2455
|
|
|
|
|
|
|
|
2456
|
|
|
|
|
|
|
This is the path to a directory of files containing Certificate Authority certificates. |
2457
|
|
|
|
|
|
|
|
2458
|
|
|
|
|
|
|
If environment variable C<PERL_LWP_SSL_CA_PATH> or C<HTTPS_CA_DIR> is set, then the ssl option property C<SSL_ca_path> takes its value. |
2459
|
|
|
|
|
|
|
|
2460
|
|
|
|
|
|
|
=back |
2461
|
|
|
|
|
|
|
|
2462
|
|
|
|
|
|
|
Other options can be set and are processed directly by the SSL Socket implementation in use. See L<IO::Socket::SSL> or L<Net::SSL> for details. |
2463
|
|
|
|
|
|
|
|
2464
|
|
|
|
|
|
|
=item * C<threshold> |
2465
|
|
|
|
|
|
|
|
2466
|
|
|
|
|
|
|
Integer. Sets the content length threshold beyond which, the response content will be stored to a locale file. It can then be fetch with L</file>. Default to global variable C<$CONTENT_SIZE_THRESHOLD>, which is C<undef> by default. |
2467
|
|
|
|
|
|
|
|
2468
|
|
|
|
|
|
|
See also the C<max_size> option. |
2469
|
|
|
|
|
|
|
|
2470
|
|
|
|
|
|
|
=item * C<timeout> |
2471
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
Integer. Sets the timeout value. Defaults to 180 seconds, i.e. 3 minutes. |
2473
|
|
|
|
|
|
|
|
2474
|
|
|
|
|
|
|
=item * C<use_content_file> |
2475
|
|
|
|
|
|
|
|
2476
|
|
|
|
|
|
|
Boolean. Enables the use of a temporary local file to store the response content, no matter the size o the response content. |
2477
|
|
|
|
|
|
|
|
2478
|
|
|
|
|
|
|
=item * C<use_promise> |
2479
|
|
|
|
|
|
|
|
2480
|
|
|
|
|
|
|
Boolean. When true, this will have L<HTTP::Promise> HTTP methods return a L<HTTP::Promise|promise>, and when false, it returns directly the L<HTTP::Promise::Response|response object>. Defaults to true. |
2481
|
|
|
|
|
|
|
|
2482
|
|
|
|
|
|
|
=back |
2483
|
|
|
|
|
|
|
|
2484
|
|
|
|
|
|
|
=head1 METHODS |
2485
|
|
|
|
|
|
|
|
2486
|
|
|
|
|
|
|
The following methods are available. This interface provides similar interface as L<LWP::UserAgent> while providing more granular control. |
2487
|
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
|
=head2 accept_encoding |
2489
|
|
|
|
|
|
|
|
2490
|
|
|
|
|
|
|
String. Sets or gets whether we should accept compressed data. |
2491
|
|
|
|
|
|
|
|
2492
|
|
|
|
|
|
|
You can set it to C<none> to disable it. By default, this is C<auto>, and it will set the C<Accept-Encoding> C<HTTP> header to all the supported encoding based on the availability of associated modules. |
2493
|
|
|
|
|
|
|
|
2494
|
|
|
|
|
|
|
You can also set this to a comma-separated list of known encoding, typically: C<bzip2,deflate,gzip,rawdeflate,brotli> |
2495
|
|
|
|
|
|
|
|
2496
|
|
|
|
|
|
|
See L<HTTP::Promise::Stream> for more details. |
2497
|
|
|
|
|
|
|
|
2498
|
|
|
|
|
|
|
Returns a L<scalar object|Module::Generic::Scalar> of the current value. |
2499
|
|
|
|
|
|
|
|
2500
|
|
|
|
|
|
|
=head2 accept_language |
2501
|
|
|
|
|
|
|
|
2502
|
|
|
|
|
|
|
An array of acceptable language. This will be used to set the C<Accept-Language> header. |
2503
|
|
|
|
|
|
|
|
2504
|
|
|
|
|
|
|
See also L<HTTP::Promise::Headers::AcceptLanguage> |
2505
|
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
|
=head2 agent |
2507
|
|
|
|
|
|
|
|
2508
|
|
|
|
|
|
|
This is a string. |
2509
|
|
|
|
|
|
|
|
2510
|
|
|
|
|
|
|
Sets or gets the agent id used to identify when making the server connection. |
2511
|
|
|
|
|
|
|
|
2512
|
|
|
|
|
|
|
It defaults to C<HTTP-Promise/v0.1.0> |
2513
|
|
|
|
|
|
|
|
2514
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( agent => 'MyBot/1.0' ); |
2515
|
|
|
|
|
|
|
$p->agent( 'Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:99.0) Gecko/20100101 Firefox/99.0' ); |
2516
|
|
|
|
|
|
|
|
2517
|
|
|
|
|
|
|
The C<User-Agent> header field is only set to this provided value if it is not already set. |
2518
|
|
|
|
|
|
|
|
2519
|
|
|
|
|
|
|
=head2 accept_language |
2520
|
|
|
|
|
|
|
|
2521
|
|
|
|
|
|
|
Sets or gets an array of acceptable response content languages. |
2522
|
|
|
|
|
|
|
|
2523
|
|
|
|
|
|
|
For example: |
2524
|
|
|
|
|
|
|
|
2525
|
|
|
|
|
|
|
$http->accept_language( [qw( fr-FR ja-JP en-GB en )] ); |
2526
|
|
|
|
|
|
|
|
2527
|
|
|
|
|
|
|
Would result into an C<Accept-Language> header set to C<fr-FR;q=0.9,ja-JP;q=0.8,en-GB;q=0.7,en;q=0.6> |
2528
|
|
|
|
|
|
|
|
2529
|
|
|
|
|
|
|
The C<Accept-Language> header would only be set if it is not set already. |
2530
|
|
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
=head2 auto_switch_https |
2532
|
|
|
|
|
|
|
|
2533
|
|
|
|
|
|
|
Boolean. If set to a true value, or if left to C<undef> (default value), this will set the C<Upgrade-Insecure-Requests> header field to C<1> |
2534
|
|
|
|
|
|
|
|
2535
|
|
|
|
|
|
|
=head2 buffer_size |
2536
|
|
|
|
|
|
|
|
2537
|
|
|
|
|
|
|
The size of the buffer to use when reading data from the filehandle or socket. |
2538
|
|
|
|
|
|
|
|
2539
|
|
|
|
|
|
|
=head2 connection_header |
2540
|
|
|
|
|
|
|
|
2541
|
|
|
|
|
|
|
Sets or gets the value for the header C<Connection>. It can be C<close> or C<keep-alive> |
2542
|
|
|
|
|
|
|
|
2543
|
|
|
|
|
|
|
If it is let C<undef>, this module will try to guess the proper value based on the L<HTTP::Promise::Request/protocol> and L<HTTP::Promise::Request/version> used. |
2544
|
|
|
|
|
|
|
|
2545
|
|
|
|
|
|
|
For protocol C<HTTP/1.0>, C<Connection> value would be C<close>, but above C<HTTP/1.1> the connection can be set to C<keep-alive> and thus be re-used. |
2546
|
|
|
|
|
|
|
|
2547
|
|
|
|
|
|
|
=head2 cookie_jar |
2548
|
|
|
|
|
|
|
|
2549
|
|
|
|
|
|
|
Sets or gets the Cookie jar class object to use. This is typically L<Cookie::Jar> or maybe L<HTTP::Cookies> |
2550
|
|
|
|
|
|
|
|
2551
|
|
|
|
|
|
|
This defaults to L<Cookie::Jar> |
2552
|
|
|
|
|
|
|
|
2553
|
|
|
|
|
|
|
use Cookie::Jar; |
2554
|
|
|
|
|
|
|
my $jar = Cookie::Jar->new; |
2555
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( cookie_jar => $jar ); |
2556
|
|
|
|
|
|
|
$p->cookie_jar( $jar ); |
2557
|
|
|
|
|
|
|
|
2558
|
|
|
|
|
|
|
=for Pod::Coverage decodable |
2559
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
=head2 decodable |
2561
|
|
|
|
|
|
|
|
2562
|
|
|
|
|
|
|
This calls L<HTTP::Promise::Stream/decodable> passing it whatever arguments that were provided. |
2563
|
|
|
|
|
|
|
|
2564
|
|
|
|
|
|
|
=head2 default_header |
2565
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
Sets one more default headers. This is a shortcut to C<< $p->default_headers->header >> |
2567
|
|
|
|
|
|
|
|
2568
|
|
|
|
|
|
|
$p->default_header( $field ); |
2569
|
|
|
|
|
|
|
$p->default_header( $field => $value ); |
2570
|
|
|
|
|
|
|
$p->default_header( 'Accept-Encoding' => scalar( HTTP::Promise->decodable ) ); |
2571
|
|
|
|
|
|
|
$p->default_header( 'Accept-Language' => 'fr, en, ja' ); |
2572
|
|
|
|
|
|
|
|
2573
|
|
|
|
|
|
|
=head2 default_headers |
2574
|
|
|
|
|
|
|
|
2575
|
|
|
|
|
|
|
Sets or gets the L<default header object|HTTP::Promise::Headers>, which is set to C<undef> by default. |
2576
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
This can be either an L<HTTP::Promise::Headers> or L<HTTP::Headers> object. |
2578
|
|
|
|
|
|
|
|
2579
|
|
|
|
|
|
|
use HTTP::Promise::Headers; |
2580
|
|
|
|
|
|
|
my $headers = HTTP::Promise::Headers->new( |
2581
|
|
|
|
|
|
|
'Accept-Encoding' => scalar( HTTP::Promise->decodable ), |
2582
|
|
|
|
|
|
|
'Accept-Language' => 'fr, en, ja', |
2583
|
|
|
|
|
|
|
); |
2584
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( default_headers => $headers ); |
2585
|
|
|
|
|
|
|
|
2586
|
|
|
|
|
|
|
=head2 default_protocol |
2587
|
|
|
|
|
|
|
|
2588
|
|
|
|
|
|
|
Sets or gets the default protocol to use. For example: C<HTTP/1.1> |
2589
|
|
|
|
|
|
|
|
2590
|
|
|
|
|
|
|
=head2 delete |
2591
|
|
|
|
|
|
|
|
2592
|
|
|
|
|
|
|
Provided with an C<uri> and an optional hash of header name/value pairs, and this will issue a C<DELETE> http request to the given C<uri>. |
2593
|
|
|
|
|
|
|
|
2594
|
|
|
|
|
|
|
It returns a L<promise|Promise::Me>, which can be used to call one or more L<then|Promise::Me/then> and L<catch|Promise::Me/catch> |
2595
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
# or $p->delete( $uri, $field1 => $value1, $field2 => $value2 ) |
2597
|
|
|
|
|
|
|
$p->delete( $uri )->then(sub |
2598
|
|
|
|
|
|
|
{ |
2599
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
2600
|
|
|
|
|
|
|
# an HTTP::Promise::Response is returned |
2601
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
2602
|
|
|
|
|
|
|
# Do something with the $resp object |
2603
|
|
|
|
|
|
|
})->catch(sub |
2604
|
|
|
|
|
|
|
{ |
2605
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
2606
|
|
|
|
|
|
|
# An HTTP::Promise::Exception object is passed with an error code |
2607
|
|
|
|
|
|
|
say( "Error code; ", $ex->code, " and message: ", $ex->message ); |
2608
|
|
|
|
|
|
|
}); |
2609
|
|
|
|
|
|
|
|
2610
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
2611
|
|
|
|
|
|
|
|
2612
|
|
|
|
|
|
|
=head2 dnt |
2613
|
|
|
|
|
|
|
|
2614
|
|
|
|
|
|
|
Boolean. If set to a true value, this will set the C<DNT> header to C<1> |
2615
|
|
|
|
|
|
|
|
2616
|
|
|
|
|
|
|
=head2 expect_threshold |
2617
|
|
|
|
|
|
|
|
2618
|
|
|
|
|
|
|
Sets or gets the body size threshold beyond which, this module will issue a conditional C<Expect> HTTP header in order to ensure the remote HTTP server is ok. |
2619
|
|
|
|
|
|
|
|
2620
|
|
|
|
|
|
|
=head2 ext_vary |
2621
|
|
|
|
|
|
|
|
2622
|
|
|
|
|
|
|
Boolean. When this is set to a true value, this will have the files use extensions that reflect not just their content, but also their encoding when applicable. |
2623
|
|
|
|
|
|
|
|
2624
|
|
|
|
|
|
|
For example, if an HTTP response HTML content is gzip encoded into a file, the file extensions will be C<html.gz> |
2625
|
|
|
|
|
|
|
|
2626
|
|
|
|
|
|
|
Default set to C<$EXTENSION_VARY>, which by default is true. |
2627
|
|
|
|
|
|
|
|
2628
|
|
|
|
|
|
|
=head2 file |
2629
|
|
|
|
|
|
|
|
2630
|
|
|
|
|
|
|
If a temporary file has been set, the response content file can be retrieved with this method. |
2631
|
|
|
|
|
|
|
|
2632
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( threshold => 512000 ); # 500kb |
2633
|
|
|
|
|
|
|
# If the response payload exceeds 500kb, HTTP::Promise will save the content to a |
2634
|
|
|
|
|
|
|
# temporary file |
2635
|
|
|
|
|
|
|
# or |
2636
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( use_content_file => 1 ); # always use a temporary file |
2637
|
|
|
|
|
|
|
# Returns a Module::Generic::File object |
2638
|
|
|
|
|
|
|
my $f = $p->file; |
2639
|
|
|
|
|
|
|
|
2640
|
|
|
|
|
|
|
=head2 from |
2641
|
|
|
|
|
|
|
|
2642
|
|
|
|
|
|
|
Get or set the email address for the human user who controls the requesting user agent. The address should be machine-usable, as defined in L<RFC2822|https://tools.ietf.org/html/rfc2822>. The C<from> value is sent as the C<From> header in the requests |
2643
|
|
|
|
|
|
|
|
2644
|
|
|
|
|
|
|
The default value is C<undef>, so no C<From> field is set by default. |
2645
|
|
|
|
|
|
|
|
2646
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( from => 'john.doe@example.com' ); |
2647
|
|
|
|
|
|
|
$p->from( 'john.doe@example.com' ); |
2648
|
|
|
|
|
|
|
|
2649
|
|
|
|
|
|
|
=head2 get |
2650
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
Provided with an C<uri> and an optional hash of header name/value pairs, and this will issue a C<GET> http request to the given C<uri>. |
2652
|
|
|
|
|
|
|
|
2653
|
|
|
|
|
|
|
It returns a L<promise|Promise::Me>, which can be used to call one or more L<then|Promise::Me/then> and L<catch|Promise::Me/catch> |
2654
|
|
|
|
|
|
|
|
2655
|
|
|
|
|
|
|
# or $p->get( $uri, $field1 => $value1, $field2 => $value2 ) |
2656
|
|
|
|
|
|
|
$p->get( $uri )->then(sub |
2657
|
|
|
|
|
|
|
{ |
2658
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
2659
|
|
|
|
|
|
|
# an HTTP::Promise::Response is returned |
2660
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
2661
|
|
|
|
|
|
|
# Do something with the $resp object |
2662
|
|
|
|
|
|
|
})->catch(sub |
2663
|
|
|
|
|
|
|
{ |
2664
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
2665
|
|
|
|
|
|
|
# An HTTP::Promise::Exception object is passed with an error code |
2666
|
|
|
|
|
|
|
say( "Error code; ", $ex->code, " and message: ", $ex->message ); |
2667
|
|
|
|
|
|
|
}); |
2668
|
|
|
|
|
|
|
|
2669
|
|
|
|
|
|
|
If you pass a special header name C<Content> or C<Query>, it will be used to set the query string of the L<URI>. |
2670
|
|
|
|
|
|
|
|
2671
|
|
|
|
|
|
|
The value can be an hash reference, and L<query_form|URI/query_form> will be called. |
2672
|
|
|
|
|
|
|
|
2673
|
|
|
|
|
|
|
If the value is a string or an object that stringifies, L<query|URI/query> will be called to set the value as-is. this option gives you direct control of the query string. |
2674
|
|
|
|
|
|
|
|
2675
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
2676
|
|
|
|
|
|
|
|
2677
|
|
|
|
|
|
|
=head2 head |
2678
|
|
|
|
|
|
|
|
2679
|
|
|
|
|
|
|
Provided with an C<uri> and an optional hash of header name/value pairs, and this will issue a C<HEAD> http request to the given C<uri>. |
2680
|
|
|
|
|
|
|
|
2681
|
|
|
|
|
|
|
It returns a L<promise|Promise::Me>, which can be used to call one or more L<then|Promise::Me/then> and L<catch|Promise::Me/catch> |
2682
|
|
|
|
|
|
|
|
2683
|
|
|
|
|
|
|
# or $p->head( $uri, $field1 => $value1, $field2 => $value2 ) |
2684
|
|
|
|
|
|
|
$p->head( $uri )->then(sub |
2685
|
|
|
|
|
|
|
{ |
2686
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
2687
|
|
|
|
|
|
|
# an HTTP::Promise::Response is returned |
2688
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
2689
|
|
|
|
|
|
|
# Do something with the $resp object |
2690
|
|
|
|
|
|
|
})->catch(sub |
2691
|
|
|
|
|
|
|
{ |
2692
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
2693
|
|
|
|
|
|
|
# An HTTP::Promise::Exception object is passed with an error code |
2694
|
|
|
|
|
|
|
say( "Error code; ", $ex->code, " and message: ", $ex->message ); |
2695
|
|
|
|
|
|
|
}); |
2696
|
|
|
|
|
|
|
|
2697
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
2698
|
|
|
|
|
|
|
|
2699
|
|
|
|
|
|
|
=head2 httpize_datetime |
2700
|
|
|
|
|
|
|
|
2701
|
|
|
|
|
|
|
Provided with a L<DateTime> or L<Module::Generic::DateTime> object, and this will ensure the C<DateTime> object stringifies to a valid HTTP datetime. |
2702
|
|
|
|
|
|
|
|
2703
|
|
|
|
|
|
|
It returns the C<DateTime> object provided upon success, or upon error, sets an L<error|Module::Generic/error> and returns C<undef> |
2704
|
|
|
|
|
|
|
|
2705
|
|
|
|
|
|
|
=head2 inactivity_timeout |
2706
|
|
|
|
|
|
|
|
2707
|
|
|
|
|
|
|
Sets or gets the inactivity timeout in seconds. If timeout is reached, the connection is closed. |
2708
|
|
|
|
|
|
|
|
2709
|
|
|
|
|
|
|
=head2 is_protocol_supported |
2710
|
|
|
|
|
|
|
|
2711
|
|
|
|
|
|
|
Provided with a protocol, such as C<http>, or C<https>, and this returns true if the protocol is supported or false otherwise. |
2712
|
|
|
|
|
|
|
|
2713
|
|
|
|
|
|
|
This basically returns true if the protocol is either C<http> or C<https> and false otherwise, because C<HTTP::Promise> supports only HTTP protocol. |
2714
|
|
|
|
|
|
|
|
2715
|
|
|
|
|
|
|
=head2 languages |
2716
|
|
|
|
|
|
|
|
2717
|
|
|
|
|
|
|
This is an alias for L</accept_language> |
2718
|
|
|
|
|
|
|
|
2719
|
|
|
|
|
|
|
=head2 local_address |
2720
|
|
|
|
|
|
|
|
2721
|
|
|
|
|
|
|
Get or set the local interface to bind to for network connections. The interface can be specified as a hostname or an IP address. This value is passed as the C<LocalHost> argument to L<IO::Socket>. |
2722
|
|
|
|
|
|
|
|
2723
|
|
|
|
|
|
|
The default value is C<undef>. |
2724
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( local_address => 'localhost' ); |
2726
|
|
|
|
|
|
|
$p->local_address( '127.0.0.1' ); |
2727
|
|
|
|
|
|
|
|
2728
|
|
|
|
|
|
|
=head2 local_host |
2729
|
|
|
|
|
|
|
|
2730
|
|
|
|
|
|
|
This is the same as L</local_address>. You can use either interchangeably. |
2731
|
|
|
|
|
|
|
|
2732
|
|
|
|
|
|
|
=head2 local_port |
2733
|
|
|
|
|
|
|
|
2734
|
|
|
|
|
|
|
Get or set the local port to use to bind to for network connections. This value is passed as the C<LocalPort> argument to L<IO::Socket> |
2735
|
|
|
|
|
|
|
|
2736
|
|
|
|
|
|
|
=head2 max_body_in_memory_size |
2737
|
|
|
|
|
|
|
|
2738
|
|
|
|
|
|
|
Sets or gets the maximum HTTP response body size beyond which the data will automatically be saved in a temporary file. |
2739
|
|
|
|
|
|
|
|
2740
|
|
|
|
|
|
|
=head2 max_headers_size |
2741
|
|
|
|
|
|
|
|
2742
|
|
|
|
|
|
|
Sets or gets the maximum HTTP response headers size, beyond which an error is triggered. |
2743
|
|
|
|
|
|
|
|
2744
|
|
|
|
|
|
|
=head2 max_redirect |
2745
|
|
|
|
|
|
|
|
2746
|
|
|
|
|
|
|
An integer. Sets or gets the maximum number of allowed redirection possible. Default is 7. |
2747
|
|
|
|
|
|
|
|
2748
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( max_redirect => 5 ); |
2749
|
|
|
|
|
|
|
$p->max_redirect(12); |
2750
|
|
|
|
|
|
|
my $max = $p->max_redirect; |
2751
|
|
|
|
|
|
|
|
2752
|
|
|
|
|
|
|
=head2 max_size |
2753
|
|
|
|
|
|
|
|
2754
|
|
|
|
|
|
|
Get or set the size limit for response content. The default is C<undef>, which means that there is no limit. If the returned response content is only partial, because the size limit was exceeded, then a C<Client-Aborted> header will be added to the response. The content might end up longer than C<max_size> as we abort once appending a chunk of data makes the length exceed the limit. The C<Content-Length> header, if present, will indicate the length of the full content and will normally not be the same as C<< length( $resp->content ) >> |
2755
|
|
|
|
|
|
|
|
2756
|
|
|
|
|
|
|
my $p = HTTP::Promise->max_size(512000); # 512kb |
2757
|
|
|
|
|
|
|
$p->max_size(512000); |
2758
|
|
|
|
|
|
|
my $max = $p->max_size; |
2759
|
|
|
|
|
|
|
|
2760
|
|
|
|
|
|
|
=head2 mirror |
2761
|
|
|
|
|
|
|
|
2762
|
|
|
|
|
|
|
Provided with an C<uri> and a C<filepath> and this will issue a conditional request to the remote server to return the remote content if it has been modified since the last modification time of the C<filepath>. Of course, if that file does not exists, then it is downloaded. If the remote resource has been changed since last time, it is downloaded again and its content stored into the C<filepath> |
2763
|
|
|
|
|
|
|
|
2764
|
|
|
|
|
|
|
Just like other http methods, this returns a L<promise|Promise::Me> object. |
2765
|
|
|
|
|
|
|
|
2766
|
|
|
|
|
|
|
It can then be used to call one or more L<then|Promise::Me/then> and L<catch|Promise::Me/catch> |
2767
|
|
|
|
|
|
|
|
2768
|
|
|
|
|
|
|
$p->mirror( $uri => '/some/where/file.txt' )->then(sub |
2769
|
|
|
|
|
|
|
{ |
2770
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
2771
|
|
|
|
|
|
|
# an HTTP::Promise::Response is returned |
2772
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
2773
|
|
|
|
|
|
|
# Do something with the $resp object |
2774
|
|
|
|
|
|
|
})->catch(sub |
2775
|
|
|
|
|
|
|
{ |
2776
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
2777
|
|
|
|
|
|
|
# An HTTP::Promise::Exception object is passed with an error code |
2778
|
|
|
|
|
|
|
say( "Error code; ", $ex->code, " and message: ", $ex->message ); |
2779
|
|
|
|
|
|
|
}); |
2780
|
|
|
|
|
|
|
|
2781
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
2782
|
|
|
|
|
|
|
|
2783
|
|
|
|
|
|
|
=head2 new_headers |
2784
|
|
|
|
|
|
|
|
2785
|
|
|
|
|
|
|
my $headers = $p->new_headers( Accept => 'text/html,application/xhtml+xml;q=0.9,*/*;q=0.8' ); |
2786
|
|
|
|
|
|
|
|
2787
|
|
|
|
|
|
|
This takes some key-value pairs as header name and value, and instantiate a new L<HTTP::Promise::Headers> object and returns it. |
2788
|
|
|
|
|
|
|
|
2789
|
|
|
|
|
|
|
If an error occurs, this set an L<error object|HTTP::Promise::Exception> and return C<undef> in scalar context or an empty list in list context. |
2790
|
|
|
|
|
|
|
|
2791
|
|
|
|
|
|
|
=head2 no_proxy |
2792
|
|
|
|
|
|
|
|
2793
|
|
|
|
|
|
|
Sets or gets a list of domain names for which the proxy will not apply. By default this is empty. |
2794
|
|
|
|
|
|
|
|
2795
|
|
|
|
|
|
|
This returns an L<array object|Module::Generic::Array> |
2796
|
|
|
|
|
|
|
|
2797
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( no_proxy => [qw( example.com www2.example.net )] ); |
2798
|
|
|
|
|
|
|
$p->no_proxy( [qw( localhost example.net )] ); |
2799
|
|
|
|
|
|
|
my $ar = $p->no_proxy; |
2800
|
|
|
|
|
|
|
say $ar->length, " proxy exception(s) set."; |
2801
|
|
|
|
|
|
|
|
2802
|
|
|
|
|
|
|
=head2 options |
2803
|
|
|
|
|
|
|
|
2804
|
|
|
|
|
|
|
Provided with an C<uri>, and this will issue an C<OPTIONS> http request to the given C<uri>. |
2805
|
|
|
|
|
|
|
|
2806
|
|
|
|
|
|
|
It returns a L<promise|Promise::Me>, which can be used to call one or more L<then|Promise::Me/then> and L<catch|Promise::Me/catch> |
2807
|
|
|
|
|
|
|
|
2808
|
|
|
|
|
|
|
# or $p->head( $uri, $field1 => $value1, $field2 => $value2 ) |
2809
|
|
|
|
|
|
|
$p->options( $uri )->then(sub |
2810
|
|
|
|
|
|
|
{ |
2811
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
2812
|
|
|
|
|
|
|
# an HTTP::Promise::Response is returned |
2813
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
2814
|
|
|
|
|
|
|
# Do something with the $resp object |
2815
|
|
|
|
|
|
|
})->catch(sub |
2816
|
|
|
|
|
|
|
{ |
2817
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
2818
|
|
|
|
|
|
|
# An HTTP::Promise::Exception object is passed with an error code |
2819
|
|
|
|
|
|
|
say( "Error code; ", $ex->code, " and message: ", $ex->message ); |
2820
|
|
|
|
|
|
|
}); |
2821
|
|
|
|
|
|
|
|
2822
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
2823
|
|
|
|
|
|
|
|
2824
|
|
|
|
|
|
|
=head2 patch |
2825
|
|
|
|
|
|
|
|
2826
|
|
|
|
|
|
|
Provided with an C<uri> and an optional hash of form data, followed by an hash of header name/value pairs and this will issue a C<PATCH> http request to the given C<uri>. |
2827
|
|
|
|
|
|
|
|
2828
|
|
|
|
|
|
|
If a special header name C<Content> is provided, its value will be used to create the key-value pairs form data. That C<Content> value can either be an array reference, or an hash reference of key-value pairs. If if is just a string, it will be used as-is as the request body. |
2829
|
|
|
|
|
|
|
|
2830
|
|
|
|
|
|
|
If a special header name C<Query> is provided, its value will be used to set the C<URI> query string. The query string thus provided must already be escaped. |
2831
|
|
|
|
|
|
|
|
2832
|
|
|
|
|
|
|
It returns a L<promise|Promise::Me>, which can be used to call one or more L<then|Promise::Me/then> and L<catch|Promise::Me/catch> |
2833
|
|
|
|
|
|
|
|
2834
|
|
|
|
|
|
|
# or $p->patch( $uri, \@form, $field1 => $value1, $field2 => $value2 ); |
2835
|
|
|
|
|
|
|
# or $p->patch( $uri, \%form, $field1 => $value1, $field2 => $value2 ); |
2836
|
|
|
|
|
|
|
# or $p->patch( $uri, $field1 => $value1, $field2 => $value2 ); |
2837
|
|
|
|
|
|
|
# or $p->patch( $uri, $field1 => $value1, $field2 => $value2, Content => \@form, Query => $escaped_string ); |
2838
|
|
|
|
|
|
|
# or $p->patch( $uri, $field1 => $value1, $field2 => $value2, Content => \%form, Query => $escaped_string ); |
2839
|
|
|
|
|
|
|
# or $p->patch( $uri, $field1 => $value1, $field2 => $value2, Content => $content, Query => $escaped_string ); |
2840
|
|
|
|
|
|
|
$p->patch( $uri )->then(sub |
2841
|
|
|
|
|
|
|
{ |
2842
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
2843
|
|
|
|
|
|
|
# an HTTP::Promise::Response is returned |
2844
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
2845
|
|
|
|
|
|
|
# Do something with the $resp object |
2846
|
|
|
|
|
|
|
})->catch(sub |
2847
|
|
|
|
|
|
|
{ |
2848
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
2849
|
|
|
|
|
|
|
# An HTTP::Promise::Exception object is passed with an error code |
2850
|
|
|
|
|
|
|
say( "Error code; ", $ex->code, " and message: ", $ex->message ); |
2851
|
|
|
|
|
|
|
}); |
2852
|
|
|
|
|
|
|
|
2853
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
2854
|
|
|
|
|
|
|
|
2855
|
|
|
|
|
|
|
=head2 post |
2856
|
|
|
|
|
|
|
|
2857
|
|
|
|
|
|
|
Provided with an C<uri> and an optional hash of form data, followed by an hash of header name/value pairs and this will issue a C<POST> http request to the given C<uri>. |
2858
|
|
|
|
|
|
|
|
2859
|
|
|
|
|
|
|
If a special header name C<Content> is provided, its value will be used to create the key-value pairs form data. That C<Content> value can either be an array reference, or an hash reference of key-value pairs. If if is just a string, it will be used as-is as the request body. |
2860
|
|
|
|
|
|
|
|
2861
|
|
|
|
|
|
|
If a special header name C<Query> is provided, its value will be used to set the C<URI> query string. The query string thus provided must already be escaped. |
2862
|
|
|
|
|
|
|
|
2863
|
|
|
|
|
|
|
How the form data is formatted depends on the C<Content-Type> set in the headers passed. If the C<Content-Type> header is C<form-data> or C<multipart/form-data>, the form data will be formatted as a C<multipart/form-data> post, otherwise they will be formatted as a C<application/x-www-form-urlencoded> post. |
2864
|
|
|
|
|
|
|
|
2865
|
|
|
|
|
|
|
It returns a L<promise|Promise::Me>, which can be used to call one or more L<then|Promise::Me/then> and L<catch|Promise::Me/catch> |
2866
|
|
|
|
|
|
|
|
2867
|
|
|
|
|
|
|
# or $p->post( $uri, \@form, $field1 => $value1, $field2 => $value2 ); |
2868
|
|
|
|
|
|
|
# or $p->post( $uri, \%form, $field1 => $value1, $field2 => $value2 ); |
2869
|
|
|
|
|
|
|
# or $p->post( $uri, $field1 => $value1, $field2 => $value2 ); |
2870
|
|
|
|
|
|
|
# or $p->post( $uri, $field1 => $value1, $field2 => $value2, Content => \@form, Query => $escaped_string ); |
2871
|
|
|
|
|
|
|
# or $p->post( $uri, $field1 => $value1, $field2 => $value2, Content => \%form, Query => $escaped_string ); |
2872
|
|
|
|
|
|
|
# or $p->post( $uri, $field1 => $value1, $field2 => $value2, Content => $content, Query => $escaped_string ); |
2873
|
|
|
|
|
|
|
$p->post( $uri )->then(sub |
2874
|
|
|
|
|
|
|
{ |
2875
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
2876
|
|
|
|
|
|
|
# an HTTP::Promise::Response is returned |
2877
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
2878
|
|
|
|
|
|
|
# Do something with the $resp object |
2879
|
|
|
|
|
|
|
})->catch(sub |
2880
|
|
|
|
|
|
|
{ |
2881
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
2882
|
|
|
|
|
|
|
# An HTTP::Promise::Exception object is passed with an error code |
2883
|
|
|
|
|
|
|
say( "Error code; ", $ex->code, " and message: ", $ex->message ); |
2884
|
|
|
|
|
|
|
}); |
2885
|
|
|
|
|
|
|
|
2886
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
2887
|
|
|
|
|
|
|
|
2888
|
|
|
|
|
|
|
=head2 prepare_headers |
2889
|
|
|
|
|
|
|
|
2890
|
|
|
|
|
|
|
Provided with an L<HTTP::Promise::Request> object, and this will set the following request headers, if they are not set already. |
2891
|
|
|
|
|
|
|
|
2892
|
|
|
|
|
|
|
You can override this method if you create a module of your own that inherits from L<HTTP::Promise>. |
2893
|
|
|
|
|
|
|
|
2894
|
|
|
|
|
|
|
It returns the L<HTTP::Promise::Request> received, or upon error, it sets an L<error|Module::Generic/error> and returns C<undef> |
2895
|
|
|
|
|
|
|
|
2896
|
|
|
|
|
|
|
Headers set, if not set already are: |
2897
|
|
|
|
|
|
|
|
2898
|
|
|
|
|
|
|
=over 4 |
2899
|
|
|
|
|
|
|
|
2900
|
|
|
|
|
|
|
=item * C<Accept> |
2901
|
|
|
|
|
|
|
|
2902
|
|
|
|
|
|
|
This uses the values set with L</accept> |
2903
|
|
|
|
|
|
|
|
2904
|
|
|
|
|
|
|
=item * C<Accept-Language> |
2905
|
|
|
|
|
|
|
|
2906
|
|
|
|
|
|
|
This uses the values set with L</accept_language> or L</languages> |
2907
|
|
|
|
|
|
|
|
2908
|
|
|
|
|
|
|
=item * C<Accept-Encoding> |
2909
|
|
|
|
|
|
|
|
2910
|
|
|
|
|
|
|
This uses the value returned from L<HTTP::Promise::Stream/decodable> to find out the encoding installed and supported on your system. |
2911
|
|
|
|
|
|
|
|
2912
|
|
|
|
|
|
|
=item * C<DNT> |
2913
|
|
|
|
|
|
|
|
2914
|
|
|
|
|
|
|
This uses the value set with L</dnt> |
2915
|
|
|
|
|
|
|
|
2916
|
|
|
|
|
|
|
=item * C<Upgrade-Insecure-Requests> |
2917
|
|
|
|
|
|
|
|
2918
|
|
|
|
|
|
|
This uses the value set with L</auto_switch_https> or L</upgrade_insecure_requests> |
2919
|
|
|
|
|
|
|
|
2920
|
|
|
|
|
|
|
=item * C<User-Agent> |
2921
|
|
|
|
|
|
|
|
2922
|
|
|
|
|
|
|
This uses the value set with L</agent> |
2923
|
|
|
|
|
|
|
|
2924
|
|
|
|
|
|
|
=back |
2925
|
|
|
|
|
|
|
|
2926
|
|
|
|
|
|
|
=head2 proxy |
2927
|
|
|
|
|
|
|
|
2928
|
|
|
|
|
|
|
Array reference. This sets the scheme and their proxy or proxies. Default to C<undef>. For example: |
2929
|
|
|
|
|
|
|
|
2930
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( proxy => [ [qw( http ftp )] => 'https://proxy.example.com:8001' ] ); |
2931
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( proxy => [ http => 'https://proxy.example.com:8001' ] ); |
2932
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( proxy => [ ftp => 'http://ftp.example.com:8001/', |
2933
|
|
|
|
|
|
|
[qw( http https )] => 'https://proxy.example.com:8001' ] ); |
2934
|
|
|
|
|
|
|
my $proxy = $p->proxy( 'https' ); |
2935
|
|
|
|
|
|
|
|
2936
|
|
|
|
|
|
|
=head2 proxy_authorization |
2937
|
|
|
|
|
|
|
|
2938
|
|
|
|
|
|
|
Sets or gets the proxy authorization string. This is computed automatically when you set a user and a password to the proxy URI by setting the value to L</proxy> |
2939
|
|
|
|
|
|
|
|
2940
|
|
|
|
|
|
|
=head2 put |
2941
|
|
|
|
|
|
|
|
2942
|
|
|
|
|
|
|
Provided with an C<uri> and an optional hash of form data, followed by an hash of header name/value pairs and this will issue a C<PUT> http request to the given C<uri>. |
2943
|
|
|
|
|
|
|
|
2944
|
|
|
|
|
|
|
If a special header name C<Content> is provided, its value will be used to create the key-value pairs form data. THat C<Content> value can either be an array reference, or an hash reference of key-value pairs. If if is just a string, it will be used as-is as the request body. |
2945
|
|
|
|
|
|
|
|
2946
|
|
|
|
|
|
|
If a special header name C<Query> is provided, its value will be used to set the C<URI> query string. The query string thus provided must already be escaped. |
2947
|
|
|
|
|
|
|
|
2948
|
|
|
|
|
|
|
How the form data is formatted depends on the C<Content-Type> set in the headers passed. If the C<Content-Type> header is C<form-data> or C<multipart/form-data>, the form data will be formatted as a C<multipart/form-data> post, otherwise they will be formatted as a C<application/x-www-form-urlencoded> put. |
2949
|
|
|
|
|
|
|
|
2950
|
|
|
|
|
|
|
It returns a L<promise|Promise::Me>, which can be used to call one or more L<then|Promise::Me/then> and L<catch|Promise::Me/catch> |
2951
|
|
|
|
|
|
|
|
2952
|
|
|
|
|
|
|
# or $p->put( $uri, \@form, $field1 => $value1, $field2 => $value2 ); |
2953
|
|
|
|
|
|
|
# or $p->put( $uri, \%form, $field1 => $value1, $field2 => $value2 ); |
2954
|
|
|
|
|
|
|
# or $p->put( $uri, $field1 => $value1, $field2 => $value2 ); |
2955
|
|
|
|
|
|
|
# or $p->put( $uri, $field1 => $value1, $field2 => $value2, Content => \@form, Query => $escaped_string ); |
2956
|
|
|
|
|
|
|
# or $p->put( $uri, $field1 => $value1, $field2 => $value2, Content => \%form, Query => $escaped_string ); |
2957
|
|
|
|
|
|
|
# or $p->put( $uri, $field1 => $value1, $field2 => $value2, Content => $content, Query => $escaped_string ); |
2958
|
|
|
|
|
|
|
$p->put( $uri )->then(sub |
2959
|
|
|
|
|
|
|
{ |
2960
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
2961
|
|
|
|
|
|
|
# an HTTP::Promise::Response is returned |
2962
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
2963
|
|
|
|
|
|
|
# Do something with the $resp object |
2964
|
|
|
|
|
|
|
})->catch(sub |
2965
|
|
|
|
|
|
|
{ |
2966
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
2967
|
|
|
|
|
|
|
# An HTTP::Promise::Exception object is passed with an error code |
2968
|
|
|
|
|
|
|
say( "Error code; ", $ex->code, " and message: ", $ex->message ); |
2969
|
|
|
|
|
|
|
}); |
2970
|
|
|
|
|
|
|
|
2971
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
2972
|
|
|
|
|
|
|
|
2973
|
|
|
|
|
|
|
=head2 request |
2974
|
|
|
|
|
|
|
|
2975
|
|
|
|
|
|
|
This method will issue the proper request in accordance with the request object provided. It will process redirects and authentication responses transparently. This means it may end up sending multiple request, up to the limit set with the object option L</max_redirect> |
2976
|
|
|
|
|
|
|
|
2977
|
|
|
|
|
|
|
This method takes the following parameters: |
2978
|
|
|
|
|
|
|
|
2979
|
|
|
|
|
|
|
=over 4 |
2980
|
|
|
|
|
|
|
|
2981
|
|
|
|
|
|
|
=item 1. a L<request object|HTTP::Promise::Request>, which is typically L<HTTP::Promise::Request>, or L<HTTP::Request>, but any class that implements a similar interface is acceptable |
2982
|
|
|
|
|
|
|
|
2983
|
|
|
|
|
|
|
=item 2. an optional hash or hash reference of parameters: |
2984
|
|
|
|
|
|
|
|
2985
|
|
|
|
|
|
|
=over 8 |
2986
|
|
|
|
|
|
|
|
2987
|
|
|
|
|
|
|
=item C<read_size> |
2988
|
|
|
|
|
|
|
|
2989
|
|
|
|
|
|
|
Integer. If provided, this will instruct to read the response by that much bytes at a time. |
2990
|
|
|
|
|
|
|
|
2991
|
|
|
|
|
|
|
=item C<use_content_file> |
2992
|
|
|
|
|
|
|
|
2993
|
|
|
|
|
|
|
Boolean. If true, this will instruct the use of a temporary file to store the response content. That file may then be retrieved with the method L</file>. |
2994
|
|
|
|
|
|
|
|
2995
|
|
|
|
|
|
|
You can also control the use of a temporary file to store the response content with the L</threshold> object option. |
2996
|
|
|
|
|
|
|
|
2997
|
|
|
|
|
|
|
=back |
2998
|
|
|
|
|
|
|
|
2999
|
|
|
|
|
|
|
=back |
3000
|
|
|
|
|
|
|
|
3001
|
|
|
|
|
|
|
It returns a L<promise object|Promise::Me> just like other methods. |
3002
|
|
|
|
|
|
|
|
3003
|
|
|
|
|
|
|
For example: |
3004
|
|
|
|
|
|
|
|
3005
|
|
|
|
|
|
|
use HTTP::Promise::Request; |
3006
|
|
|
|
|
|
|
my $req = HTTP::Promise::Request->new( get => 'https://example.com' ); |
3007
|
|
|
|
|
|
|
my $p = HTTP::Promise->new; |
3008
|
|
|
|
|
|
|
my $prom = $p->request( $req )->then(sub |
3009
|
|
|
|
|
|
|
{ |
3010
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
3011
|
|
|
|
|
|
|
# Get the HTTP::Promise::Response object |
3012
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
3013
|
|
|
|
|
|
|
# Do something with the response object |
3014
|
|
|
|
|
|
|
})->catch(sub |
3015
|
|
|
|
|
|
|
{ |
3016
|
|
|
|
|
|
|
# Get a HTTP::Promise::Exception object |
3017
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
3018
|
|
|
|
|
|
|
say "Got an error code ", $ex->code, " with message: ", $ex->message; |
3019
|
|
|
|
|
|
|
}); |
3020
|
|
|
|
|
|
|
|
3021
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
3022
|
|
|
|
|
|
|
|
3023
|
|
|
|
|
|
|
=head2 requests_redirectable |
3024
|
|
|
|
|
|
|
|
3025
|
|
|
|
|
|
|
Array reference. Sets or gets the list of http method that are allowed to be redirected. By default this is an empty list, i.e. all http methods are allowed to be redirected. Defaults to C<GET> and C<HEAD> as per L<rfc 2616|https://tools.ietf.org/html/rfc2616> |
3026
|
|
|
|
|
|
|
|
3027
|
|
|
|
|
|
|
This returns an L<array object|Module::Generic::Array> |
3028
|
|
|
|
|
|
|
|
3029
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( requests_redirectable => [qw( HEAD GET POST )] ); |
3030
|
|
|
|
|
|
|
$p->requests_redirectable( [qw( HEAD GET POST )] ); |
3031
|
|
|
|
|
|
|
my $ok_redir = $p->requests_redirectable; |
3032
|
|
|
|
|
|
|
# Add put |
3033
|
|
|
|
|
|
|
$ok_redir->push( 'PUT' ); |
3034
|
|
|
|
|
|
|
# Remove POST we just added |
3035
|
|
|
|
|
|
|
$ok_redir->remove( 'POST' ); |
3036
|
|
|
|
|
|
|
|
3037
|
|
|
|
|
|
|
=head2 send |
3038
|
|
|
|
|
|
|
|
3039
|
|
|
|
|
|
|
Provided with an L<HTTP::Promise::Request>, and an optional hash or hash reference of options and this will attempt to connect to the specified L<uri|HTTP::Promise::Request/uri> |
3040
|
|
|
|
|
|
|
|
3041
|
|
|
|
|
|
|
Supported options: |
3042
|
|
|
|
|
|
|
|
3043
|
|
|
|
|
|
|
=over 4 |
3044
|
|
|
|
|
|
|
|
3045
|
|
|
|
|
|
|
=item * C<expect_threshold> |
3046
|
|
|
|
|
|
|
|
3047
|
|
|
|
|
|
|
A number specifying the request body size threshold beyond which, this will issue a conditional C<Expect> HTTP header. |
3048
|
|
|
|
|
|
|
|
3049
|
|
|
|
|
|
|
=item * C<total_attempts> |
3050
|
|
|
|
|
|
|
|
3051
|
|
|
|
|
|
|
Total number of attempts. This is a value that is decreased for each redirected requests it receives until the maximum is reached. The maximum is specified with L</max_redirect> |
3052
|
|
|
|
|
|
|
|
3053
|
|
|
|
|
|
|
After connected to the remote server, it will send the request using L<HTTP::Promise::Request/print>, and reads the HTTP response, possibly C<chunked>. |
3054
|
|
|
|
|
|
|
|
3055
|
|
|
|
|
|
|
It returns a new L<HTTP::Promise::Response> object, or upon error, this sets an L<error|Module::Generic/error> and returns C<undef> |
3056
|
|
|
|
|
|
|
|
3057
|
|
|
|
|
|
|
=back |
3058
|
|
|
|
|
|
|
|
3059
|
|
|
|
|
|
|
=head2 send_te |
3060
|
|
|
|
|
|
|
|
3061
|
|
|
|
|
|
|
Boolean. Enables or disables the C<TE> http header. Defaults to true. If true, the C<TE> will be added to the outgoing http request. |
3062
|
|
|
|
|
|
|
|
3063
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( send_te => 1 ); |
3064
|
|
|
|
|
|
|
$p->send_te(1); |
3065
|
|
|
|
|
|
|
my $bool = $p->send_te; |
3066
|
|
|
|
|
|
|
|
3067
|
|
|
|
|
|
|
=head2 serialiser |
3068
|
|
|
|
|
|
|
|
3069
|
|
|
|
|
|
|
String. Sets or gets the serialiser to use for L<Promise::Me>. Possible values are: L<cbor|CBOR::XS>, L<sereal|Sereal> or L<storable|Storable::Improved> |
3070
|
|
|
|
|
|
|
|
3071
|
|
|
|
|
|
|
By default, the value is set to the global variable C<$SERIALISER>, which is a copy of the C<$SERIALISER> in L<Promise::Me>, which should be by default C<storable> |
3072
|
|
|
|
|
|
|
|
3073
|
|
|
|
|
|
|
=head2 simple_request |
3074
|
|
|
|
|
|
|
|
3075
|
|
|
|
|
|
|
This method takes the same parameters as L</request> and differs in that it will not try to handle redirects or authentication. |
3076
|
|
|
|
|
|
|
|
3077
|
|
|
|
|
|
|
It returns a L<promise object|Promise::Me> just like other methods. |
3078
|
|
|
|
|
|
|
|
3079
|
|
|
|
|
|
|
For example: |
3080
|
|
|
|
|
|
|
|
3081
|
|
|
|
|
|
|
use HTTP::Promise::Request; |
3082
|
|
|
|
|
|
|
my $req = HTTP::Promise::Request->new( get => 'https://example.com' ); |
3083
|
|
|
|
|
|
|
my $p = HTTP::Promise->new; |
3084
|
|
|
|
|
|
|
my $prom = $p->simple_request( $req )->then(sub |
3085
|
|
|
|
|
|
|
{ |
3086
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
3087
|
|
|
|
|
|
|
# Get the HTTP::Promise::Response object |
3088
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
3089
|
|
|
|
|
|
|
# Do something with the response object |
3090
|
|
|
|
|
|
|
})->catch(sub |
3091
|
|
|
|
|
|
|
{ |
3092
|
|
|
|
|
|
|
# Get a HTTP::Promise::Exception object |
3093
|
|
|
|
|
|
|
my $ex = shift( @_ ); |
3094
|
|
|
|
|
|
|
say "Got an error code ", $ex->code, " with message: ", $ex->message; |
3095
|
|
|
|
|
|
|
}); |
3096
|
|
|
|
|
|
|
|
3097
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
3098
|
|
|
|
|
|
|
|
3099
|
|
|
|
|
|
|
=head2 ssl_opts |
3100
|
|
|
|
|
|
|
|
3101
|
|
|
|
|
|
|
L<Hash reference object|Module::Generic::Hash>. Sets or gets the ssl options properties used when making requests over ssl. The default values are set as follows: |
3102
|
|
|
|
|
|
|
|
3103
|
|
|
|
|
|
|
=over 8 |
3104
|
|
|
|
|
|
|
|
3105
|
|
|
|
|
|
|
=item 1. C<verify_hostname> |
3106
|
|
|
|
|
|
|
|
3107
|
|
|
|
|
|
|
When enabled, this ensures it connects to servers that have a valid certificate matching the expected hostname. |
3108
|
|
|
|
|
|
|
|
3109
|
|
|
|
|
|
|
=over 12 |
3110
|
|
|
|
|
|
|
|
3111
|
|
|
|
|
|
|
=item 1.1. If environment variable C<PERL_LWP_SSL_VERIFY_HOSTNAME> is set, the ssl option property C<verify_hostname> takes its value. |
3112
|
|
|
|
|
|
|
|
3113
|
|
|
|
|
|
|
=item 1.2. If environment variable C<HTTPS_CA_FILE> or C<HTTPS_CA_DIR> are set to a true value, then the ssl option property C<verify_hostname> is set to C<0> and option property C<SSL_verify_mode> is set to C<1> |
3114
|
|
|
|
|
|
|
|
3115
|
|
|
|
|
|
|
=item 1.3 If none of the above applies, it defaults C<verify_hostname> to C<1> |
3116
|
|
|
|
|
|
|
|
3117
|
|
|
|
|
|
|
=back |
3118
|
|
|
|
|
|
|
|
3119
|
|
|
|
|
|
|
=item 2. C<SSL_ca_file> |
3120
|
|
|
|
|
|
|
|
3121
|
|
|
|
|
|
|
This is the path to a file containing the Certificate Authority certificates. |
3122
|
|
|
|
|
|
|
|
3123
|
|
|
|
|
|
|
If environment variable C<PERL_LWP_SSL_CA_FILE> or C<HTTPS_CA_FILE> is set, then the ssl option property C<SSL_ca_file> takes its value. |
3124
|
|
|
|
|
|
|
|
3125
|
|
|
|
|
|
|
=item 3. C<SSL_ca_path> |
3126
|
|
|
|
|
|
|
|
3127
|
|
|
|
|
|
|
This is the path to a directory of files containing Certificate Authority certificates. |
3128
|
|
|
|
|
|
|
|
3129
|
|
|
|
|
|
|
If environment variable C<PERL_LWP_SSL_CA_PATH> or C<HTTPS_CA_DIR> is set, then the ssl option property C<SSL_ca_path> takes its value. |
3130
|
|
|
|
|
|
|
|
3131
|
|
|
|
|
|
|
=back |
3132
|
|
|
|
|
|
|
|
3133
|
|
|
|
|
|
|
Other options can be set and are processed directly by the SSL Socket implementation in use. See L<IO::Socket::SSL> or L<Net::SSL> for details. |
3134
|
|
|
|
|
|
|
|
3135
|
|
|
|
|
|
|
=head2 stop_if |
3136
|
|
|
|
|
|
|
|
3137
|
|
|
|
|
|
|
Sets or gets a callback code reference (reference to a perl subroutine or an anonymous subroutine) that will be used to determine if we should keep trying upon reading data from the filehandle and an C<EINTR> error occurs. |
3138
|
|
|
|
|
|
|
|
3139
|
|
|
|
|
|
|
If the callback returns true, further attempts will stop and return an error. The default is to continue trying. |
3140
|
|
|
|
|
|
|
|
3141
|
|
|
|
|
|
|
=head2 threshold |
3142
|
|
|
|
|
|
|
|
3143
|
|
|
|
|
|
|
Integer. Sets the content length threshold beyond which, the response content will be stored to a locale file. It can then be fetch with L</file>. Default to global variable C<$CONTENT_SIZE_THRESHOLD>, which is C<undef> by default. |
3144
|
|
|
|
|
|
|
|
3145
|
|
|
|
|
|
|
See also the L</max_size> option. |
3146
|
|
|
|
|
|
|
|
3147
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( threshold => 512000 ); |
3148
|
|
|
|
|
|
|
$p->threshold(512000); |
3149
|
|
|
|
|
|
|
my $limit = $p->threshold; |
3150
|
|
|
|
|
|
|
|
3151
|
|
|
|
|
|
|
=head2 timeout |
3152
|
|
|
|
|
|
|
|
3153
|
|
|
|
|
|
|
Integer. Sets the timeout value. Defaults to 180 seconds, i.e. 3 minutes. |
3154
|
|
|
|
|
|
|
|
3155
|
|
|
|
|
|
|
The request is aborted if no activity on the connection to the server is observed for C<timeout> seconds. When a request times out, a L<response object|HTTP::Promise::Response> is still returned. The response object will have a standard http status code of C<500>, i.e. server error. This response will have the C<Client-Warning> header set to the value of C<Internal response>. |
3156
|
|
|
|
|
|
|
|
3157
|
|
|
|
|
|
|
Returns a L<number object|Module::Generic::Number> |
3158
|
|
|
|
|
|
|
|
3159
|
|
|
|
|
|
|
my $p = HTTP::Promise->new( timeout => 10 ); |
3160
|
|
|
|
|
|
|
$p->timeout(10); |
3161
|
|
|
|
|
|
|
my $timeout = $p->timeout; |
3162
|
|
|
|
|
|
|
|
3163
|
|
|
|
|
|
|
=head2 upgrade_insecure_requests |
3164
|
|
|
|
|
|
|
|
3165
|
|
|
|
|
|
|
This is an alias for L</auto_switch_https> |
3166
|
|
|
|
|
|
|
|
3167
|
|
|
|
|
|
|
=head2 uri_escape |
3168
|
|
|
|
|
|
|
|
3169
|
|
|
|
|
|
|
URI-escape the given string using L<URI::Escape::XS/uri_escape> |
3170
|
|
|
|
|
|
|
|
3171
|
|
|
|
|
|
|
=head2 uri_unescape |
3172
|
|
|
|
|
|
|
|
3173
|
|
|
|
|
|
|
URI-unescape the given string using L<URI::Escape::XS/uri_unescape> |
3174
|
|
|
|
|
|
|
|
3175
|
|
|
|
|
|
|
=head2 use_content_file |
3176
|
|
|
|
|
|
|
|
3177
|
|
|
|
|
|
|
Boolean. Enables or disables the use of a temporary file to store the response content. Defaults to false. |
3178
|
|
|
|
|
|
|
|
3179
|
|
|
|
|
|
|
When true, the response content will be stored into a temporary file, whose object is a L<Module::Generic::File> object and can be retrieved with L</file>. |
3180
|
|
|
|
|
|
|
|
3181
|
|
|
|
|
|
|
=head2 use_promise |
3182
|
|
|
|
|
|
|
|
3183
|
|
|
|
|
|
|
Boolean. When true, this will have L<HTTP::Promise> HTTP methods return a L<HTTP::Promise|promise>, and when false, it returns directly the L<HTTP::Promise::Response|response object>. Defaults to true. |
3184
|
|
|
|
|
|
|
|
3185
|
|
|
|
|
|
|
=head1 CLASS FUNCTIONS |
3186
|
|
|
|
|
|
|
|
3187
|
|
|
|
|
|
|
=head2 fetch |
3188
|
|
|
|
|
|
|
|
3189
|
|
|
|
|
|
|
This method can be exported, such as: |
3190
|
|
|
|
|
|
|
|
3191
|
|
|
|
|
|
|
use HTTP::Promise qw( fetch ); |
3192
|
|
|
|
|
|
|
my $prom = fetch( 'http://example.com/something.json' ); |
3193
|
|
|
|
|
|
|
# or |
3194
|
|
|
|
|
|
|
fetch( 'http://example.com/something.json' )->then(sub |
3195
|
|
|
|
|
|
|
{ |
3196
|
|
|
|
|
|
|
my( $resolve, $reject ) = @$_; |
3197
|
|
|
|
|
|
|
my $resp = shift( @_ ); |
3198
|
|
|
|
|
|
|
my $data = $resp->decoded_content; |
3199
|
|
|
|
|
|
|
})->then(sub |
3200
|
|
|
|
|
|
|
{ |
3201
|
|
|
|
|
|
|
my $json = shift( @_ ); |
3202
|
|
|
|
|
|
|
print( STDOUT "JSON data:\n$json\n" ); |
3203
|
|
|
|
|
|
|
}); |
3204
|
|
|
|
|
|
|
|
3205
|
|
|
|
|
|
|
You can also call it with an object, such as: |
3206
|
|
|
|
|
|
|
|
3207
|
|
|
|
|
|
|
my $http = HTTP::Promise->new; |
3208
|
|
|
|
|
|
|
my $prom = $http->fetch( 'http://example.com/something.json' ); |
3209
|
|
|
|
|
|
|
|
3210
|
|
|
|
|
|
|
C<fetch> performs the same way as L</get>, by default, and accepts the same possible parameters. It sets an error and returns C<undef> upon error, or return a L<promise|Promise::Me> |
3211
|
|
|
|
|
|
|
|
3212
|
|
|
|
|
|
|
However, if L</use_promise> is set to false, this will return an L<HTTP::Promise::Response> object directly. |
3213
|
|
|
|
|
|
|
|
3214
|
|
|
|
|
|
|
You can, however, specify, another method by providing the C<method> option with value being an HTTP method, i.e. C<DELETE>, C<GET>, C<HEAD>, C<OPTIONS>, C<PATCH>, C<POST>, C<PUT>. |
3215
|
|
|
|
|
|
|
|
3216
|
|
|
|
|
|
|
See also L<Mozilla documentation on fetch|https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API/Using_Fetch> |
3217
|
|
|
|
|
|
|
|
3218
|
|
|
|
|
|
|
=head1 AUTHOR |
3219
|
|
|
|
|
|
|
|
3220
|
|
|
|
|
|
|
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt> |
3221
|
|
|
|
|
|
|
|
3222
|
|
|
|
|
|
|
=head1 CREDITS |
3223
|
|
|
|
|
|
|
|
3224
|
|
|
|
|
|
|
This module is inspired by the design and workflow of Gisle Aas and his implementation of L<HTTP::Message>, but built completely differently. |
3225
|
|
|
|
|
|
|
|
3226
|
|
|
|
|
|
|
L<HTTP::Promise::Entity> and L<HTTP::Promise::Body> have been inspired by Erik Dorfman (a.k.a. Eryq) and Dianne Skoll's implementation of L<MIME::Entity> |
3227
|
|
|
|
|
|
|
|
3228
|
|
|
|
|
|
|
=head1 BUGS |
3229
|
|
|
|
|
|
|
|
3230
|
|
|
|
|
|
|
You can report bugs at <https://gitlab.com/jackdeguest/HTTP-Promise/issues> |
3231
|
|
|
|
|
|
|
|
3232
|
|
|
|
|
|
|
=head1 SEE ALSO |
3233
|
|
|
|
|
|
|
|
3234
|
|
|
|
|
|
|
L<HTTP::Promise>, L<HTTP::Promise::Request>, L<HTTP::Promise::Response>, L<HTTP::Promise::Message>, L<HTTP::Promise::Entity>, L<HTTP::Promise::Headers>, L<HTTP::Promise::Body>, L<HTTP::Promise::Body::Form>, L<HTTP::Promise::Body::Form::Data>, L<HTTP::Promise::Body::Form::Field>, L<HTTP::Promise::Status>, L<HTTP::Promise::MIME>, L<HTTP::Promise::Parser>, L<HTTP::Promise::IO>, L<HTTP::Promise::Stream>, L<HTTP::Promise::Exception> |
3235
|
|
|
|
|
|
|
|
3236
|
|
|
|
|
|
|
L<Promise::Me>, L<Cookie::Jar>, L<Module::Generic::File>, L<Module::Generic::Scalar>, L<Module::Generic> |
3237
|
|
|
|
|
|
|
|
3238
|
|
|
|
|
|
|
L<HTTP::XSHeaders>, L<File::MMagic::XS>, L<CryptX>, L<HTTP::Parser2::XS>, L<URI::Encode::XS>, L<URI::Escape::XS>, L<URL::Encode::XS> |
3239
|
|
|
|
|
|
|
|
3240
|
|
|
|
|
|
|
L<IO::Compress::Bzip2>, L<IO::Compress::Deflate>, L<IO::Compress::Gzip>, L<IO::Compress::Lzf>, L<IO::Compress::Lzip>, L<IO::Compress::Lzma>, L<IO::Compress::Lzop>, L<IO::Compress::RawDeflate>, L<IO::Compress::Xz>, L<IO::Compress::Zip>, L<IO::Compress::Zstd> |
3241
|
|
|
|
|
|
|
|
3242
|
|
|
|
|
|
|
L<rfc6266 on Content-Disposition|https://datatracker.ietf.org/doc/html/rfc6266>, |
3243
|
|
|
|
|
|
|
L<rfc7230 on Message Syntax and Routing|https://tools.ietf.org/html/rfc7230>, |
3244
|
|
|
|
|
|
|
L<rfc7231 on Semantics and Content|https://tools.ietf.org/html/rfc7231>, |
3245
|
|
|
|
|
|
|
L<rfc7232 on Conditional Requests|https://tools.ietf.org/html/rfc7232>, |
3246
|
|
|
|
|
|
|
L<rfc7233 on Range Requests|https://tools.ietf.org/html/rfc7233>, |
3247
|
|
|
|
|
|
|
L<rfc7234 on Caching|https://tools.ietf.org/html/rfc7234>, |
3248
|
|
|
|
|
|
|
L<rfc7235 on Authentication|https://tools.ietf.org/html/rfc7235>, |
3249
|
|
|
|
|
|
|
L<rfc7578 on multipart/form-data|https://tools.ietf.org/html/rfc7578>, |
3250
|
|
|
|
|
|
|
L<rfc7540 on HTTP/2.0|https://tools.ietf.org/html/rfc7540> |
3251
|
|
|
|
|
|
|
|
3252
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
3253
|
|
|
|
|
|
|
|
3254
|
|
|
|
|
|
|
Copyright (c) 2021 DEGUEST Pte. Ltd. |
3255
|
|
|
|
|
|
|
|
3256
|
|
|
|
|
|
|
You can use, copy, modify and redistribute this package and associated files under the same terms as Perl itself. |
3257
|
|
|
|
|
|
|
|
3258
|
|
|
|
|
|
|
=cut |