File Coverage

lib/HTTP/Promise.pm
Criterion Covered Total %
statement 77 949 8.1
branch 0 540 0.0
condition 0 483 0.0
subroutine 22 105 20.9
pod 59 61 96.7
total 158 2138 7.3


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Asynchronous HTTP Request and Promise - ~/lib/HTTP/Promise.pm
3             ## Version v0.3.1
4             ## Copyright(c) 2023 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/05/06
7             ## Modified 2023/09/22
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   705476 use strict;
  2         15  
  2         63  
18 2     2   10 use warnings;
  2         8  
  2         53  
19 2     2   10 use warnings::register;
  2         3  
  2         238  
20 2     2   12 use parent qw( Module::Generic );
  2         5  
  2         31  
21 2         358 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   109178 $SERIALISER @EXPORT_OK );
  2         13  
26 2     2   1454 use Cookie;
  2         1826283  
  2         35  
27 2     2   2761 use Cookie::Jar;
  2         465090  
  2         48  
28 2     2   1962 use Errno qw( EAGAIN ECONNRESET EINPROGRESS EINTR EWOULDBLOCK ECONNABORTED EISCONN );
  2         3108  
  2         278  
29 2     2   887 use HTTP::Promise::Exception;
  2         6  
  2         22  
30 2     2   1633 use HTTP::Promise::IO;
  2         10  
  2         22  
31 2     2   1365 use HTTP::Promise::Pool;
  2         7  
  2         19  
32 2     2   1505 use HTTP::Promise::Request;
  2         8  
  2         46  
33 2     2   1621 use HTTP::Promise::Response;
  2         8  
  2         32  
34 2     2   560 use HTTP::Promise::Status qw( :all );
  2         8  
  2         12  
35             # use Nice::Try;
36 2     2   1927 use Promise::Me;
  2         9646485  
  2         13  
37 2     2   9903441 use Scalar::Util ();
  2         6  
  2         57  
38 2     2   12 use URI;
  2         3  
  2         56  
39 2     2   10 use URI::Escape::XS ();
  2         8  
  2         137  
40             # < 0 so we recognise those as system errors
41             use constant {
42 2         744 ERROR_EINTR => ( abs( Errno::EINTR ) * -1 ),
43             TYPE_URL_ENCODED => 'application/x-www-form-urlencoded',
44 2     2   12 };
  2         6  
45 2     2   13 our @EXPORT_OK = qw( fetch );
46             # "\r\n" is not portable
47 2         5 our $CRLF = "\015\012";
48 2         3 our $DEFAULT_PROTOCOL = 'HTTP/1.1';
49 2         5 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         3 our $MAX_HEADERS_SIZE = 8192;
55             # 256Kb
56 2         5 our $MAX_BODY_IN_MEMORY_SIZE = 102400;
57             # 1Mb
58 2         3 our $EXPECT_THRESHOLD = 1024000000;
59 2         6 our $EXTENSION_VARY = 1;
60 2         3 our $DEFAULT_MIME_TYPE = 'application/octet-stream';
61 2         4 our $SERIALISER = $Promise::Me::SERIALISER;
62 2         43 our $VERSION = 'v0.3.1';
63             };
64              
65 2     2   15 use strict;
  2         5  
  2         58  
66 2     2   11 use warnings;
  2         5  
  2         20813  
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.1
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