line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
2
|
|
|
|
|
|
|
## Asynchronous HTTP Request and Promise - ~/lib/HTTP/Promise/Response.pm |
3
|
|
|
|
|
|
|
## Version v0.1.0 |
4
|
|
|
|
|
|
|
## Copyright(c) 2022 DEGUEST Pte. Ltd. |
5
|
|
|
|
|
|
|
## Author: Jacques Deguest <jack@deguest.jp> |
6
|
|
|
|
|
|
|
## Created 2022/03/21 |
7
|
|
|
|
|
|
|
## Modified 2022/03/21 |
8
|
|
|
|
|
|
|
## All rights reserved |
9
|
|
|
|
|
|
|
## |
10
|
|
|
|
|
|
|
## This program is free software; you can redistribute it and/or modify it |
11
|
|
|
|
|
|
|
## under the same terms as Perl itself. |
12
|
|
|
|
|
|
|
##---------------------------------------------------------------------------- |
13
|
|
|
|
|
|
|
package HTTP::Promise::Response; |
14
|
|
|
|
|
|
|
BEGIN |
15
|
|
|
|
|
|
|
{ |
16
|
4
|
|
|
4
|
|
256867
|
use strict; |
|
4
|
|
|
|
|
15
|
|
|
4
|
|
|
|
|
146
|
|
17
|
4
|
|
|
4
|
|
30
|
use warnings; |
|
4
|
|
|
|
|
12
|
|
|
4
|
|
|
|
|
185
|
|
18
|
4
|
|
|
4
|
|
21
|
use warnings::register; |
|
4
|
|
|
|
|
14
|
|
|
4
|
|
|
|
|
917
|
|
19
|
4
|
|
|
4
|
|
27
|
use parent qw( HTTP::Promise::Message ); |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
46
|
|
20
|
4
|
|
|
4
|
|
359
|
use vars qw( $DEFAULT_PROTOCOL $VERSION ); |
|
4
|
|
|
|
|
15
|
|
|
4
|
|
|
|
|
290
|
|
21
|
4
|
|
|
4
|
|
3404
|
use HTTP::Promise::Status; |
|
4
|
|
|
|
|
15
|
|
|
4
|
|
|
|
|
27
|
|
22
|
4
|
|
|
4
|
|
22
|
our $DEFAULT_PROTOCOL = 'HTTP/1.0'; |
23
|
4
|
|
|
|
|
79
|
our $VERSION = 'v0.1.0'; |
24
|
|
|
|
|
|
|
}; |
25
|
|
|
|
|
|
|
|
26
|
4
|
|
|
4
|
|
26
|
use strict; |
|
4
|
|
|
|
|
22
|
|
|
4
|
|
|
|
|
83
|
|
27
|
4
|
|
|
4
|
|
23
|
use warnings; |
|
4
|
|
|
|
|
17
|
|
|
4
|
|
|
|
|
9351
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub init |
30
|
|
|
|
|
|
|
{ |
31
|
8
|
|
|
8
|
1
|
1703
|
my $self = shift( @_ ); |
32
|
8
|
|
|
|
|
17
|
my( $code, $status ); |
33
|
8
|
100
|
|
|
|
55
|
if( @_ ) |
34
|
|
|
|
|
|
|
{ |
35
|
5
|
50
|
33
|
|
|
224
|
if( @_ == 1 && ref( $_[0] ) eq 'HASH' ) |
|
|
50
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
36
|
|
|
|
|
|
|
{ |
37
|
0
|
|
|
|
|
0
|
my $opts = $_[0]; |
38
|
0
|
|
|
|
|
0
|
( $code, $status ) = CORE::delete( @$opts{qw( code status )} ); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
elsif( @_ >= 2 && |
41
|
|
|
|
|
|
|
defined( $_[0] ) && |
42
|
|
|
|
|
|
|
$_[0] =~ /^\d{3}$/ && |
43
|
|
|
|
|
|
|
( ( defined( $_[1] ) && $_[1] =~ /\S/ ) || !defined( $_[1] ) ) ) |
44
|
|
|
|
|
|
|
{ |
45
|
5
|
|
|
|
|
37
|
( $code, $status ) = splice( @_, 0, 2 ); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
else |
48
|
|
|
|
|
|
|
{ |
49
|
0
|
0
|
|
|
|
0
|
return( $self->error( "Invalid parameters received. I was expecting either an hash reference or at least a code and status, but instead got: ", join( ", ", map( defined( $_ ) ? "'$_'" : 'undef', @_ ) ) ) ); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
# properties headers and content are set by our parent class HTTP::Promise::Message |
53
|
8
|
|
|
|
|
292
|
$self->{code} = $code; |
54
|
8
|
|
|
|
|
51
|
$self->{cookies} = []; |
55
|
8
|
|
|
|
|
33
|
$self->{default_protocol} = $DEFAULT_PROTOCOL; |
56
|
8
|
|
|
|
|
31
|
$self->{previous} = undef; |
57
|
8
|
|
|
|
|
23
|
$self->{request} = undef; |
58
|
8
|
|
|
|
|
22
|
$self->{status} = $status; |
59
|
8
|
|
|
|
|
23
|
$self->{version} = ''; |
60
|
8
|
|
|
|
|
29
|
$self->{_init_strict_use_sub} = 1; |
61
|
8
|
|
|
|
|
38
|
$self->{_init_params_order} = [qw( content headers )]; |
62
|
|
|
|
|
|
|
# $self->SUPER::init( ( defined( $headers ) ? $headers : () ), @_ ) || return( $self->pass_error ); |
63
|
8
|
50
|
|
|
|
95
|
$self->SUPER::init( @_ ) || return( $self->pass_error ); |
64
|
8
|
|
|
|
|
154
|
return( $self ); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub base |
68
|
|
|
|
|
|
|
{ |
69
|
4
|
|
|
4
|
1
|
552
|
my $self = shift( @_ ); |
70
|
4
|
|
|
|
|
13
|
my $base = ( |
71
|
|
|
|
|
|
|
$self->header( 'Content-Base' ), # used to be HTTP/1.1 |
72
|
|
|
|
|
|
|
$self->header( 'Content-Location' ), # HTTP/1.1 |
73
|
|
|
|
|
|
|
$self->header( 'Base' ), # HTTP/1.0 |
74
|
|
|
|
|
|
|
)[0]; |
75
|
4
|
50
|
|
|
|
18
|
$self->_load_class( 'URI', { version => 5.10 } ) || return( $self->pass_error ); |
76
|
4
|
50
|
66
|
|
|
149
|
if( $base && $base =~ /^[a-zA-Z][a-zA-Z0-9.+\-]*:/ ) |
77
|
|
|
|
|
|
|
{ |
78
|
|
|
|
|
|
|
# already absolute |
79
|
0
|
|
|
|
|
0
|
return( URI->new( $base ) ); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
4
|
|
|
|
|
13
|
my $req = $self->request; |
83
|
4
|
50
|
|
|
|
92
|
if( $req ) |
84
|
|
|
|
|
|
|
{ |
85
|
|
|
|
|
|
|
# if $base is undef here, the return value is effectively |
86
|
|
|
|
|
|
|
# just a copy of $self->request->uri. |
87
|
4
|
|
|
|
|
14
|
return( URI->new_abs( $base, $req->uri ) ); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
# Cannot find an absolute base |
90
|
0
|
|
|
|
|
0
|
return; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub clone |
94
|
|
|
|
|
|
|
{ |
95
|
2
|
|
|
2
|
1
|
36627
|
my $self = shift( @_ ); |
96
|
2
|
|
|
|
|
40
|
my $new = $self->SUPER::clone; |
97
|
2
|
|
|
|
|
13
|
my $code = $self->code; |
98
|
2
|
|
|
|
|
1557
|
my $status = $self->status; |
99
|
2
|
|
|
|
|
1580
|
my $prev = $self->previous; |
100
|
2
|
|
|
|
|
73
|
my $req = $self->request; |
101
|
2
|
|
|
|
|
61
|
$new->code( $code ); |
102
|
2
|
|
|
|
|
73013
|
$new->status( $status ); |
103
|
2
|
|
|
|
|
1827
|
$new->previous( undef ); |
104
|
|
|
|
|
|
|
# $new->previous( $prev ) if( defined( $prev ) ); |
105
|
2
|
100
|
|
|
|
102
|
$new->request( $req->clone ) if( defined( $req ) ); |
106
|
2
|
|
|
|
|
87
|
return( $new ); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
23
|
|
|
23
|
1
|
40674
|
sub code { return( shift->_set_get_number( 'code', @_ ) ); } |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub current_age |
112
|
|
|
|
|
|
|
{ |
113
|
13
|
|
|
13
|
1
|
145
|
my $self = shift( @_ ); |
114
|
13
|
|
|
|
|
20
|
my $time = shift( @_ ); |
115
|
|
|
|
|
|
|
|
116
|
13
|
|
|
|
|
243
|
my $h_client_date = $self->client_date; |
117
|
13
|
|
|
|
|
229
|
my $h_date = $self->date; |
118
|
|
|
|
|
|
|
# Implementation of RFC 2616 section 13.2.3 |
119
|
|
|
|
|
|
|
# (age calculations) |
120
|
13
|
100
|
|
|
|
402
|
my $response_time = $h_client_date->epoch if( $h_client_date ); |
121
|
13
|
100
|
|
|
|
441
|
my $date = $h_date->epoch if( $h_date ); |
122
|
|
|
|
|
|
|
|
123
|
13
|
|
|
|
|
326
|
my $age = 0; |
124
|
13
|
100
|
100
|
|
|
55
|
if( $response_time && $date ) |
125
|
|
|
|
|
|
|
{ |
126
|
|
|
|
|
|
|
# apparent_age |
127
|
9
|
|
|
|
|
17
|
$age = $response_time - $date; |
128
|
9
|
100
|
|
|
|
29
|
$age = 0 if( $age < 0 ); |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
13
|
|
|
|
|
45
|
my $age_v = $self->header( 'Age' ); |
132
|
13
|
100
|
100
|
|
|
52
|
if( $age_v && $age_v > $age ) |
133
|
|
|
|
|
|
|
{ |
134
|
|
|
|
|
|
|
# corrected_received_age |
135
|
4
|
|
|
|
|
8
|
$age = $age_v; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
13
|
100
|
|
|
|
30
|
if( $response_time ) |
139
|
|
|
|
|
|
|
{ |
140
|
10
|
|
|
|
|
30
|
my $request = $self->request; |
141
|
10
|
100
|
|
|
|
266
|
if( $request ) |
142
|
|
|
|
|
|
|
{ |
143
|
8
|
|
|
|
|
161
|
my $req_date = $request->date; |
144
|
8
|
100
|
|
|
|
282
|
my $request_time = $req_date->epoch if( $req_date ); |
145
|
8
|
100
|
100
|
|
|
349
|
if( $request_time && $request_time < $response_time ) |
146
|
|
|
|
|
|
|
{ |
147
|
|
|
|
|
|
|
# Add response_delay to age to get 'corrected_initial_age' |
148
|
6
|
|
|
|
|
16
|
$age += $response_time - $request_time; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} |
151
|
10
|
|
66
|
|
|
37
|
$age += ( $time || time ) - $response_time; |
152
|
|
|
|
|
|
|
} |
153
|
13
|
|
|
|
|
80
|
return( $age ); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
0
|
1
|
0
|
sub default_protocol { return( shift->_set_get_scalar_as_object( 'default_protocol', @_ ) ); } |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub dump |
159
|
|
|
|
|
|
|
{ |
160
|
1
|
|
|
1
|
1
|
762
|
my $self = shift( @_ ); |
161
|
1
|
|
|
|
|
4
|
my $status_line = $self->status_line; |
162
|
1
|
|
|
|
|
5
|
my $proto = $self->protocol; |
163
|
1
|
50
|
|
|
|
774
|
$status_line = "$proto $status_line" if( $proto ); |
164
|
1
|
|
|
|
|
28
|
return( $self->SUPER::dump( preheader => $status_line, @_ ) ); |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub filename |
168
|
|
|
|
|
|
|
{ |
169
|
10
|
|
|
10
|
1
|
4239
|
my $self = shift( @_ ); |
170
|
10
|
|
|
|
|
20
|
my $file; |
171
|
10
|
|
|
|
|
35
|
my $dispo = $self->header( 'Content-Disposition' ); |
172
|
|
|
|
|
|
|
# e.g.: attachment; filename="filename.jpg" |
173
|
|
|
|
|
|
|
# form-data; name="fieldName"; filename="filename.jpg" |
174
|
|
|
|
|
|
|
# Ref: <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Content-Disposition> |
175
|
10
|
100
|
|
|
|
40
|
if( $dispo ) |
176
|
|
|
|
|
|
|
{ |
177
|
7
|
|
|
|
|
17
|
my $cd = $self->headers->new_field( 'Content-Disposition' => "$dispo" ); |
178
|
7
|
50
|
|
|
|
19
|
return( $self->pass_error( $self->headers->error ) ) if( !defined( $cd ) ); |
179
|
7
|
|
|
|
|
17
|
$file = $cd->filename; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
10
|
100
|
66
|
|
|
153
|
unless( defined( $file ) && length( $file ) ) |
183
|
|
|
|
|
|
|
{ |
184
|
5
|
50
|
|
|
|
33
|
$self->_load_class( 'URI', { version => 5.10 } ) || return( $self->pass_error ); |
185
|
5
|
|
|
|
|
179
|
my $uri; |
186
|
5
|
100
|
|
|
|
18
|
if( my $cl = $self->header( 'Content-Location' ) ) |
|
|
100
|
|
|
|
|
|
187
|
|
|
|
|
|
|
{ |
188
|
1
|
|
|
|
|
10
|
$uri = URI->new( $cl ); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
elsif( my $request = $self->request ) |
191
|
|
|
|
|
|
|
{ |
192
|
3
|
|
|
|
|
108
|
$uri = $request->uri; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
5
|
100
|
|
|
|
2599
|
if( $uri ) |
196
|
|
|
|
|
|
|
{ |
197
|
2
|
|
|
|
|
30
|
my $f = $self->new_file( $uri->path ); |
198
|
2
|
|
|
|
|
259127
|
$file = $f->basename; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
10
|
100
|
|
|
|
7386
|
if( $file ) |
203
|
|
|
|
|
|
|
{ |
204
|
|
|
|
|
|
|
# basename |
205
|
7
|
|
|
|
|
65
|
$file =~ s,.*[\\/],,; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
10
|
50
|
66
|
|
|
82
|
if( $file && !length( $file ) ) |
209
|
|
|
|
|
|
|
{ |
210
|
0
|
|
|
|
|
0
|
$file = undef; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
10
|
|
|
|
|
187
|
return( $file ); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub fresh_until |
217
|
|
|
|
|
|
|
{ |
218
|
5
|
|
|
5
|
1
|
764
|
my $self = shift( @_ ); |
219
|
5
|
|
|
|
|
22
|
my $opts = $self->_get_args_as_hash( @_ ); |
220
|
5
|
|
66
|
|
|
469
|
$opts->{time} ||= time; |
221
|
5
|
|
|
|
|
24
|
my $f = $self->freshness_lifetime( %$opts ); |
222
|
5
|
100
|
|
|
|
29
|
return unless( defined( $f ) ); |
223
|
4
|
|
|
|
|
23
|
return( $f - $self->current_age( $opts->{time} ) + $opts->{time} ); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub freshness_lifetime |
227
|
|
|
|
|
|
|
{ |
228
|
24
|
|
|
24
|
1
|
1741
|
my $self = shift( @_ ); |
229
|
24
|
|
|
|
|
87
|
my $opts = $self->_get_args_as_hash( @_ ); |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# First look for the Cache-Control: max-age=n header |
232
|
24
|
|
|
|
|
2444
|
for my $cc ( $self->header( 'Cache-Control' ) ) |
233
|
|
|
|
|
|
|
{ |
234
|
6
|
50
|
33
|
|
|
26
|
next if( !defined( $cc ) || !length( "$cc" ) ); |
235
|
6
|
|
|
|
|
14
|
for my $cc_dir ( split( /[[:blank:]\h]*,[[:blank:]\h]*/, $cc ) ) |
236
|
|
|
|
|
|
|
{ |
237
|
6
|
100
|
|
|
|
36
|
return( $1 ) if( $cc_dir =~ /^max-age[[:blank:]\h]*=[[:blank:]\h]*(\d+)/i ); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
21
|
|
|
|
|
428
|
my $h_date = $self->date; |
242
|
21
|
|
|
|
|
327
|
my $h_client_date = $self->client_date; |
243
|
|
|
|
|
|
|
# Next possibility is to look at the "Expires" header |
244
|
|
|
|
|
|
|
my $date = ( $h_date ? $h_date->epoch : '' ) || |
245
|
|
|
|
|
|
|
( $h_client_date ? $h_client_date->epoch : '' ) || |
246
|
21
|
|
66
|
|
|
464
|
$opts->{time} || time; |
247
|
21
|
100
|
|
|
|
765
|
if( my $expires = $self->expires ) |
248
|
|
|
|
|
|
|
{ |
249
|
1
|
|
|
|
|
16
|
return( $expires->epoch - $date ); |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# Must apply heuristic expiration |
253
|
20
|
100
|
100
|
|
|
89
|
return if( exists( $opts->{heuristic_expiry} ) && !$opts->{heuristic_expiry} ); |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# Default heuristic expiration parameters |
256
|
16
|
|
100
|
|
|
81
|
$opts->{h_min} ||= 60; |
257
|
16
|
|
100
|
|
|
66
|
$opts->{h_max} ||= 24 * 3600; |
258
|
|
|
|
|
|
|
# 10% since last-mod suggested by RFC2616 |
259
|
16
|
|
100
|
|
|
63
|
$opts->{h_lastmod_fraction} ||= 0.10; |
260
|
16
|
|
100
|
|
|
61
|
$opts->{h_default} ||= 3600; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# Should give a warning if more than 24 hours according to |
263
|
|
|
|
|
|
|
# RFC 2616 section 13.2.4. Here we just make this the default |
264
|
|
|
|
|
|
|
# maximum value. |
265
|
16
|
100
|
|
|
|
238
|
if( my $last_modified = $self->last_modified ) |
266
|
|
|
|
|
|
|
{ |
267
|
12
|
|
|
|
|
100
|
my $h_exp = ( $date - $last_modified ) * $opts->{h_lastmod_fraction}; |
268
|
12
|
100
|
|
|
|
43475
|
return( $opts->{h_min} ) if( $h_exp < $opts->{h_min} ); |
269
|
10
|
100
|
|
|
|
74
|
return( $opts->{h_max} ) if( $h_exp > $opts->{h_max} ); |
270
|
2
|
|
|
|
|
15
|
return( $h_exp ); |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# default when all else fails |
274
|
4
|
100
|
|
|
|
21
|
return( $opts->{h_min} ) if( $opts->{h_min} > $opts->{h_default} ); |
275
|
3
|
|
|
|
|
18
|
return( $opts->{h_default} ); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
1
|
|
|
1
|
1
|
2979
|
sub is_client_error { return( HTTP::Promise::Status->is_client_error( shift->code ) ); } |
279
|
|
|
|
|
|
|
|
280
|
1
|
|
|
1
|
1
|
2943
|
sub is_error { return( HTTP::Promise::Status->is_error( shift->code ) ); } |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub is_fresh |
283
|
|
|
|
|
|
|
{ |
284
|
3
|
|
|
3
|
1
|
432
|
my $self = shift( @_ ); |
285
|
3
|
|
|
|
|
13
|
my $opts = $self->_get_args_as_hash( @_ ); |
286
|
3
|
|
66
|
|
|
336
|
$opts->{time} ||= time; |
287
|
3
|
|
|
|
|
17
|
my $f = $self->freshness_lifetime( %$opts ); |
288
|
3
|
100
|
|
|
|
18
|
return unless( defined( $f ) ); |
289
|
2
|
|
|
|
|
10
|
return( $f > $self->current_age( $opts->{time} ) ); |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
1
|
|
|
1
|
1
|
3300
|
sub is_info { return( HTTP::Promise::Status->is_info( shift->code ) ); } |
293
|
|
|
|
|
|
|
|
294
|
1
|
|
|
1
|
1
|
3042
|
sub is_redirect { return( HTTP::Promise::Status->is_redirect( shift->code ) ); } |
295
|
|
|
|
|
|
|
|
296
|
1
|
|
|
1
|
1
|
2928
|
sub is_server_error { return( HTTP::Promise::Status->is_server_error( shift->code ) ); } |
297
|
|
|
|
|
|
|
|
298
|
4
|
|
|
4
|
1
|
4298
|
sub is_success { return( HTTP::Promise::Status->is_success( shift->code ) ); } |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
sub parse |
301
|
|
|
|
|
|
|
{ |
302
|
3
|
|
|
3
|
1
|
1684
|
my $self = shift( @_ ); |
303
|
3
|
|
|
|
|
7
|
my $str = shift( @_ ); |
304
|
3
|
100
|
33
|
|
|
603
|
warnings::warnif( 'Undefined argument to ' . ( ref( $self ) || $self ) . '->parse()' ) if( !defined( $str ) ); |
305
|
3
|
|
|
|
|
91
|
$self->clear_error; |
306
|
3
|
100
|
66
|
|
|
164
|
if( !defined( $str ) || !length( $str ) ) |
307
|
|
|
|
|
|
|
{ |
308
|
2
|
50
|
|
|
|
12
|
return( ref( $self ) ? $self : $self->new ); |
309
|
|
|
|
|
|
|
} |
310
|
1
|
|
|
|
|
40
|
$str = $self->new_scalar( $str ); |
311
|
1
|
50
|
|
|
|
32
|
$self->_load_class( 'HTTP::Promise::Parser' ) || return( $self->pass_error ); |
312
|
1
|
|
|
|
|
64
|
my $p = HTTP::Promise::Parser->new; |
313
|
1
|
|
50
|
|
|
35
|
my $ent = $p->parse( $str ) || return( $self->pass_error( $p->error ) ); |
314
|
1
|
|
|
|
|
326
|
return( $ent->http_message ); |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
16
|
|
|
16
|
1
|
36664
|
sub previous { return( shift->_set_get_object_without_init( 'previous', 'HTTP::Promise::Message', @_ ) ); } |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
sub redirects |
320
|
|
|
|
|
|
|
{ |
321
|
4
|
|
|
4
|
1
|
37200
|
my $self = shift( @_ ); |
322
|
4
|
|
|
|
|
18
|
my $reds = $self->new_array; |
323
|
4
|
|
|
|
|
82
|
my $r = $self; |
324
|
4
|
|
|
|
|
12
|
while( my $p = $r->previous ) |
325
|
|
|
|
|
|
|
{ |
326
|
5
|
|
|
|
|
113
|
$reds->unshift( $p ); |
327
|
5
|
|
|
|
|
36
|
$r = $p; |
328
|
|
|
|
|
|
|
} |
329
|
4
|
|
|
|
|
115
|
return( $reds ); |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
25
|
|
|
25
|
1
|
1402
|
sub request { return( shift->_set_get_object_without_init( 'request', 'HTTP::Promise::Request', @_ ) ); } |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# See rfc7230, section 3.1 <https://tools.ietf.org/html/rfc7230#section-3.1> |
335
|
|
|
|
|
|
|
sub start_line |
336
|
|
|
|
|
|
|
{ |
337
|
4
|
|
|
4
|
1
|
11
|
my $self = shift( @_ ); |
338
|
4
|
|
|
|
|
9
|
my $eol = shift( @_ ); |
339
|
4
|
50
|
|
|
|
14
|
$eol = "\n" if( !defined( $eol ) ); |
340
|
4
|
|
|
|
|
16
|
my $status_line = $self->status_line; |
341
|
4
|
|
100
|
|
|
58
|
my $proto = $self->protocol || 'HTTP/1.1'; |
342
|
4
|
|
|
|
|
3184
|
my $resp_line = "$proto $status_line"; |
343
|
4
|
|
|
|
|
37
|
return( $resp_line ); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
15
|
|
|
15
|
1
|
93052
|
sub status { return( shift->_set_get_scalar_as_object( 'status', @_ ) ); } |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
sub status_line |
349
|
|
|
|
|
|
|
{ |
350
|
6
|
|
|
6
|
1
|
948
|
my $self = shift( @_ ); |
351
|
6
|
|
100
|
|
|
23
|
my $code = $self->code || "000"; |
352
|
6
|
|
100
|
|
|
41840
|
my $status = $self->status || HTTP::Promise::Status->status_message( $code ) || 'Unknown code'; |
353
|
6
|
|
|
|
|
2465
|
return( "$code $status" ); |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
# NOTE: sub FREEZE is inherited |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
# NOTE: sub STORABLE_freeze is inherited |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# NOTE: sub STORABLE_thaw is inherited |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
# NOTE: sub THAW is inherited |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
1; |
365
|
|
|
|
|
|
|
# NOTE: POD |
366
|
|
|
|
|
|
|
__END__ |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=encoding utf-8 |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=head1 NAME |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
HTTP::Promise::Response - HTTP Response Class |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=head1 SYNOPSIS |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
use HTTP::Promise::Response; |
377
|
|
|
|
|
|
|
my $resp = HTTP::Promise::Response->new || |
378
|
|
|
|
|
|
|
die( HTTP::Promise::Response->error, "\n" ); |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=head1 VERSION |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
v0.1.0 |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=head1 DESCRIPTION |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
L<HTTP::Promise::Response> implements a similar interface to L<HTTP::Response>, but does not inherit from it. It uses a different API internally and relies on XS modules for speed while offering more features. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
L<HTTP::Promise::Response> inherits from L<HTTP::Promise::Message> |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
One major difference with C<HTTP::Response> is that the HTTP response content is not necessarily stored in memory, but it relies on L<HTTP::Promise::Body> as you can see below, and this class has 2 subclasses: 1 storing data in memory when the size is reasonable (threshold set by you) and 1 storing data in a file on the filesystem for larger content. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Here is how it fits in overall relation with other classes. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
+-------------------------+ +--------------------------+ |
395
|
|
|
|
|
|
|
| | | | |
396
|
|
|
|
|
|
|
| HTTP::Promise::Request | | HTTP::Promise::Response | |
397
|
|
|
|
|
|
|
| | | | |
398
|
|
|
|
|
|
|
+------------|------------+ +-------------|------------+ |
399
|
|
|
|
|
|
|
| | |
400
|
|
|
|
|
|
|
| | |
401
|
|
|
|
|
|
|
| | |
402
|
|
|
|
|
|
|
| +------------------------+ | |
403
|
|
|
|
|
|
|
| | | | |
404
|
|
|
|
|
|
|
+--- HTTP::Promise::Message |---+ |
405
|
|
|
|
|
|
|
| | |
406
|
|
|
|
|
|
|
+------------|-----------+ |
407
|
|
|
|
|
|
|
| |
408
|
|
|
|
|
|
|
| |
409
|
|
|
|
|
|
|
+------------|-----------+ |
410
|
|
|
|
|
|
|
| | |
411
|
|
|
|
|
|
|
| HTTP::Promise::Entity | |
412
|
|
|
|
|
|
|
| | |
413
|
|
|
|
|
|
|
+------------|-----------+ |
414
|
|
|
|
|
|
|
| |
415
|
|
|
|
|
|
|
| |
416
|
|
|
|
|
|
|
+------------|-----------+ |
417
|
|
|
|
|
|
|
| | |
418
|
|
|
|
|
|
|
| HTTP::Promise::Body | |
419
|
|
|
|
|
|
|
| | |
420
|
|
|
|
|
|
|
+------------------------+ |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=head2 new |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
my $resp = HTTP::Promise::Response->new( $code, $status, $headers, $content, |
427
|
|
|
|
|
|
|
host => 'example.com', |
428
|
|
|
|
|
|
|
uri => 'https://example.com/somewhere', |
429
|
|
|
|
|
|
|
); |
430
|
|
|
|
|
|
|
my $resp = HTTP::Promise::Response->new( $code, $status, $headers, $content, { |
431
|
|
|
|
|
|
|
host => 'example.com', |
432
|
|
|
|
|
|
|
uri => 'https://example.com/somewhere', |
433
|
|
|
|
|
|
|
}); |
434
|
|
|
|
|
|
|
my $resp = HTTP::Promise::Response->new( $code, $status, $headers, |
435
|
|
|
|
|
|
|
host => 'example.com', |
436
|
|
|
|
|
|
|
uri => 'https://example.com/somewhere', |
437
|
|
|
|
|
|
|
); |
438
|
|
|
|
|
|
|
my $resp = HTTP::Promise::Response->new( $code, $status, $headers, { |
439
|
|
|
|
|
|
|
host => 'example.com', |
440
|
|
|
|
|
|
|
uri => 'https://example.com/somewhere', |
441
|
|
|
|
|
|
|
}); |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
Provided with an HTTP code, HTTP status, an optional set of headers, as either an array reference or a L<HTTP::Promise::Headers> or a L<HTTP::Headers> object, some optional content and an optional hash reference of options (as the last or only parameter), and this instantiates a new L<HTTP::Promise::Response> object. The supported arguments are as follow. Each arguments can be set or changed later using the method with the same name. |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
It returns the newly created object upon success, and upon error, such as bad argument provided, this sets an L<error|Module::Generic/error> and returns C<undef> |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=over 4 |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=item 1. C<$code> |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
An integer representing the status code, such as C<101> (switching protocol). |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=item 2. C<$status> |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
The status string, such as C<Switching Protocol>. |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=item 3. C<$headers> |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
Either an array reference of header-value pairs, or an L<HTTP::Promise::Headers> object or an L<HTTP::Headers> object. |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
If an array reference is provided, an L<HTTP::Promise::Headers> object will be instantiated with it. |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
For example:: |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
my $r = HTTP::Promise::Response->new( $code, $status, [ |
466
|
|
|
|
|
|
|
'Content-Type' => 'text/html; charset=utf-8', |
467
|
|
|
|
|
|
|
Content_Encoding => 'gzip', |
468
|
|
|
|
|
|
|
]); |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=item 4. C<$content> |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
C<$content> can either be a string, a scalar reference, or an L<HTTP::Promise::Body> object (L<HTTP::Promise::Body::File> and L<HTTP::Promise::Body::Scalar>) |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=back |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
Each supported option below can also be set using its corresponding method. |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
Supported options are: |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=over 4 |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=item * C<code> |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
Same as C<$code> above. |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
=item * C<content> |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
Same as C<$content> above. |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=item * C<headers> |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
Same as C<$headers> above. |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=item * C<protocol> |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
The HTTP protocol, such as C<HTTP/1.1> or C<HTTP/2> |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=item * C<status> |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
Same as C<$status> above. |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=item * C<version> |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
The HTTP protocol version. Defaults to C<1.17> |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=back |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=head1 METHODS |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=head2 add_content |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/add_content> |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
=head2 add_content_utf8 |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/add_content_utf8> |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
=head2 add_part |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/add_part> |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
=head2 as_string |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/as_string> |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=head2 base |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
Returns the base URI as an L<URI> object if it can find one, or C<undef> otherwise. |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
=head2 boundary |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message> and returns the multipart boundary currently set in the C<Content-Type> header. |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=head2 can |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/can> |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
=head2 clear |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/clear> |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head2 clone |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
This clones the current object and returns the clone version. |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=head2 code |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
Sets or gets the HTTP response C<code>. This returns a L<number object|Module::Generic::Number> |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=head2 content |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/content> |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
Use this method with care, because it will stringify the request body, thus loading it into memory, which could potentially be important if the body size is large. Maybe you can check the body size first? Something like: |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
my $content; |
557
|
|
|
|
|
|
|
$content = $r->content if( $r->body->length < 102400 ); |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=head2 content_charset |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/content_charset> |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
=head2 content_ref |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/content_ref> |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=head2 current_age |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
Calculates the "current age" of the response as specified by L<rfc2616, section 13.2.3|https://tools.ietf.org/html/rfc2616#section-13.2.3>. |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
The age of a response is the time since it was sent by the origin server. |
572
|
|
|
|
|
|
|
The returned value is a number representing the age in seconds. |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=head2 decodable |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/decodable> |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=head2 decode |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/decode> |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
=head2 decode_content |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/decode_content> |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
=head2 decoded_content |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/decoded_content> |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=head2 decoded_content_utf8 |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/decoded_content_utf8> |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=head2 default_protocol |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Sets or gets the default HTTP protocol to use. This defaults to C<HTTP/1.0> |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=head2 dump |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
This dumps the HTTP response and prints it on the C<STDOUT> in void context, or returns a string of it. |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
=head2 encode |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/encode> |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
=head2 entity |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
Sets or gets an L<HTTP::Promise::Entity> object. |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
This object is automatically created upon instantiation of the HTTP request, and if you also provide some content when creating a new object, an L<HTTP::Promise::Body> object will also be created. |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=head2 filename |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
Returns a possible filename, if any, for this response. |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
To achieve this, it tries different approaches: |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
=over 4 |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=item 1. C<Content-Disposition> header |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
It will check in the C<Content-Disposition> header of the response to see if there ia a C<filename> attribute, or a C<filename*> attribute (as defined in L<rfc2231|https://tools.ietf.org/html/rfc2231>) |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
For example: |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
Content-Disposition: form-data; name="myfile"; filename*=UTF-8''%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB.txt |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
or |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
Content-Disposition: form-data; name="myfile"; filename*=UTF-8'ja-JP'%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB.txt |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
In the above example, note the C<*> after the attribute name C<filename>. It is not a typo and part of the L<rfc2231 standard|https://tools.ietf.org/html/rfc2231> |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
or encoded with quoted-printable |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
Content-Disposition: attachment; filename="=?UTF-8?Q?=E3=83=95=E3=82=A1=E3=82=A4=E3=83=AB.txt?=" |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
or encoded with base64 |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
Content-Disposition: attachment; filename="=?UTF-8?B?44OV44Kh44Kk44OrLnR4dAo?=" |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
Here the filename would be C<ファイル.txt> (i.e. "file.txt" in Japanese) |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=item 2. C<Content-Location> header |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
It will use the base filename of the URI. |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
=item 3. C<request URI> |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
If there was an initial request URI, it will use the URI base filename. |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
This might not be the original request URI, because there might have been some redirect responses first. |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
=back |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
Whatever filename found is returned as-is. You need to be careful there are no dangerous characters in it before relying on it as part of a filepath. |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
If nothing is found, C<undef> is returned. |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=head2 fresh_until |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
Returns the time (in seconds since epoch) when this entity is no longer fresh. |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
Options might be passed to control expiry heuristics. See the description of L</freshness_lifetime>. |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=head2 freshness_lifetime |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
Calculates the "freshness lifetime" of the response as specified by L<rfc2616, section 13.2.4|https://tools.ietf.org/html/rfc2616#section-13.2.4> and updated by L<rfc7234, section 4.2|https://tools.ietf.org/html/rfc7234#section-4.2>. |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
The "freshness lifetime" is the length of time between the generation of a response and its expiration time. |
671
|
|
|
|
|
|
|
The returned value is the number of seconds until expiry. |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
If the response does not contain an C<Expires> or a C<Cache-Control> header, then this function will apply some simple heuristic based on the C<Last-Modified> header to determine a suitable lifetime. The following options might be passed to control the heuristics: |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=over 4 |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=item * C<heuristic_expiry> |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
Boolean. If set to a false value, do not apply heuristics and just return C<undef> when C<Expires> or C<Cache-Control> field is lacking. |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=item * C<h_lastmod_fraction> |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
Integer. This number represent the fraction of the difference since the C<Last-Modified> timestamp to make the expiry time. |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
The default is C<0.10>, the suggested typical setting of 10% in L<rfc2616|https://tools.ietf.org/html/rfc2616>. |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=item * C<h_min> |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
Integer representing seconds. This is the lower limit of the heuristic expiry age to use. |
690
|
|
|
|
|
|
|
The default is C<60> (1 minute). |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=item * C<h_max> |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
Integer representing seconds. This is the upper limit of the heuristic expiry age to use. |
695
|
|
|
|
|
|
|
The default is C<86400> (24 hours). |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=item * C<h_default> |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
Integer representing seconds. This is the expiry age to use when nothing else applies. |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
The default is C<3600> (1 hour) or C<h_min> if greater. |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
=back |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=head2 header |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/header> |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=head2 headers |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
Sets or gets a L<HTTP::Promise::Headers> object. |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
A header object is always created upon instantiation, whether you provided headers fields or not. |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=head2 headers_as_string |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/headers_as_string> |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=head2 is_client_error |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
Returns true if the L</code> corresponds to a client error, which typically is a code from C<400> to C<499>, or false otherwise. |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
See also L<HTTP::Promise::Status/is_client_error> |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=head2 is_encoding_supported |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/is_encoding_supported> |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=head2 is_error |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Returns true if the L</code> corresponds to an error (client error or server error), which typically is a code from C<400> to C<599>, or false otherwise. |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
See also L<HTTP::Promise::Status/is_error> |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=head2 is_fresh |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
Returns true if the response is fresh, based on the values of L</freshness_lifetime> and L</current_age>. |
738
|
|
|
|
|
|
|
If the response is no longer fresh, then it has to be re-fetched or re-validated by the origin server. |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
Options might be passed to control expiry heuristics, see the description of L</freshness_lifetime>. |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=head2 is_info |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
Returns true if the L</code> corresponds to an informational code, which typically is a code from C<100> to C<199>, or false otherwise. |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
See also L<HTTP::Promise::Status/is_info> |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=head2 is_redirect |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Returns true if the L</code> corresponds to a redirection, which typically is a code from C<300> to C<399>, or false otherwise. |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
See also L<HTTP::Promise::Status/is_redirect> |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=head2 is_server_error |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Returns true if the L</code> corresponds to a server error, which typically is a code from C<500> to C<599>, or false otherwise. |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
See also L<HTTP::Promise::Status/is_server_error> |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=head2 is_success |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
Returns true if the L</code> corresponds to a successful response, which typically is a code from C<200> to C<299>, or false otherwise. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
See also L<HTTP::Promise::Status/is_success> |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
=head2 make_boundary |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/make_boundary> |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=head2 parse |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
Provided with a scalar reference of data, a glob or a file path, and an hash or hash reference of options and this will parse the data provided using L<HTTP::Promise::Parser/parse>, passing it whatever options has been provided. See L<HTTP::Promise::Parser/parse_fh> for the supported options. |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
This returns the resulting L<HTTP::Promise::Message> object from the parsing, or, upon error, sets an L<error|Module::Generic/error> and returns C<undef>. |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
Note that the resulting L<HTTP::Promise::Message> object can be a L<HTTP::Promise::Request> or L<HTTP::Promise::Response> object (both of which inherits from L<HTTP::Promise::Message>) if a start-line was found, or else just an L<HTTP::Promise::Message> object. |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=head2 parts |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/parts> |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
=head2 previous |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
Sets or gets an L<HTTP::Promise::Message> object corresponding to the previous HTTP query. This is used to keep track of redirection. |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=head2 protocol |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/protocol> |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=head2 redirects |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
Returns an L<array object|Module::Generic::Array> of redirect responses that lead up to this response by following the C<$r->previous> chain. The list order is oldest first. |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
For example: |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
my $reds = $r->redirects; |
797
|
|
|
|
|
|
|
say "Number of redirects: ", $reds->length; |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=head2 request |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
Sets or gets the L<HTTP::Promise::Request> related to this response. |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
It is not necessarily the same request passed to the L<HTTP::Promise/request>, because there might have been redirects and authorisation retries in between. |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=head2 start_line |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
Returns a string representing the start-line containing the L<protocol|/protocol>, the L<code|/code> and the L<status|/status> of the response. |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
For example: |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
GET / HTTP/1.1 |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
See L<rfc7230, section 3.1|https://tools.ietf.org/html/rfc7230#section-3.1> |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
=head2 status |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
Sets or gets the response status string, such as C<OK> for code C<200>. This returns a L<scalar object|Module::Generic::Scalar> |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=head2 status_line |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
Returns a regular string made of the L</code> and the L</status>. If no status is set, this will guess it from L<HTTP::Promise::Status/status_message> |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=head2 version |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
This is inherited from L<HTTP::Promise::Message>. See L<HTTP::Promise::Message/version> |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=head1 AUTHOR |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt> |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=head1 SEE ALSO |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
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> |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
Copyright(c) 2022 DEGUEST Pte. Ltd. |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
All rights reserved |
840
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=cut |