line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package HTTP::Method; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
HTTP::Method - HTTP Request Method and Common Properties according to RFC 7231 |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 VERSION |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
Version 0.01 |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=cut |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
14
|
|
|
|
|
|
|
|
15
|
3
|
|
|
3
|
|
202088
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
69
|
|
16
|
3
|
|
|
3
|
|
10
|
use warnings; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
60
|
|
17
|
|
|
|
|
|
|
|
18
|
3
|
|
|
3
|
|
15
|
use Carp; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
162
|
|
19
|
|
|
|
|
|
|
|
20
|
3
|
|
|
|
|
19
|
use overload '""' => \&_to_string, |
21
|
3
|
|
|
3
|
|
12
|
fallback => 1; |
|
3
|
|
|
|
|
2
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 SYNOPSIS |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use HTTP::Method; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# prefered instantiation |
28
|
|
|
|
|
|
|
my $get_mth = HTTP::Method->GET; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# or from string |
31
|
|
|
|
|
|
|
my $str_mth = HTTP::Method->new(uc 'get'); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# testing |
34
|
|
|
|
|
|
|
if ( $mth->is_GET ) { ... } |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# introspection |
37
|
|
|
|
|
|
|
$mth->is_method_safe; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
or more intuative (and less strict!) |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
use HTTP::Method ':case-insesitive'; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my $mth = HTTP::Method->new($str); |
44
|
|
|
|
|
|
|
printf "%s %s return the payload", |
45
|
|
|
|
|
|
|
$mth, |
46
|
|
|
|
|
|
|
$mth->is_head ? "does NOT" : "does"; |
47
|
|
|
|
|
|
|
# "GET does return the payload" |
48
|
|
|
|
|
|
|
# "HEAD does NOT return the payload" |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=cut |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 DESCRIPTION |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
There is a lot to say about HTTP Methods in L. |
55
|
|
|
|
|
|
|
Most of the developers make the wrong assumption that it is just a 'uppercase |
56
|
|
|
|
|
|
|
string'. This module will help writing better code as it does validation and |
57
|
|
|
|
|
|
|
ensures right capitalization for the HTTP Method names. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
As one could read in L |
60
|
|
|
|
|
|
|
HTTP Methods do have properties and can be divided in: I, |
61
|
|
|
|
|
|
|
I and I. These properties are just |
62
|
|
|
|
|
|
|
predicate methods on a C object |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=cut |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# this matrix is taken from RFC7231 and RFC5789 |
67
|
|
|
|
|
|
|
# or https://en.wikipedia.org/wiki/Hypertext_Transfer_Protocol#Request_methods |
68
|
|
|
|
|
|
|
# |
69
|
|
|
|
|
|
|
my %METHOD = ( |
70
|
|
|
|
|
|
|
CONNECT => { }, |
71
|
|
|
|
|
|
|
DELETE => { is_idempotent => 1, }, |
72
|
|
|
|
|
|
|
GET => { is_safe => 1, is_idempotent => 1, is_cachable => 1 }, |
73
|
|
|
|
|
|
|
HEAD => { is_safe => 1, is_idempotent => 1, is_cachable => 1 }, |
74
|
|
|
|
|
|
|
OPTIONS => { is_safe => 1, is_idempotent => 1, }, |
75
|
|
|
|
|
|
|
PATCH => { is_cachable => 1 }, |
76
|
|
|
|
|
|
|
POST => { is_cachable => 1 }, |
77
|
|
|
|
|
|
|
PUT => { is_idempotent => 1, }, |
78
|
|
|
|
|
|
|
TRACE => { is_safe => 1, is_idempotent => 1, }, |
79
|
|
|
|
|
|
|
); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head1 CLASS METHODS |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=cut |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
our $CASE_INSENSITIVE; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head2 import |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Called when module is being C |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
use HTTP::Method ':case-insensitive'; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
such that: |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
my $str = 'get'; # or result from functioncall |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
my $mth = HTTP::Method->new($str); |
98
|
|
|
|
|
|
|
# do not need to make uppercase |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
my $del = HTTP::Method->DEL; # prefer uppercase |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
print $mth if $mth->is_get; # prints "GET" |
103
|
|
|
|
|
|
|
# predicate method is lowercase |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=cut |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub import { |
108
|
3
|
|
|
3
|
|
14
|
my $class = shift; |
109
|
3
|
|
|
|
|
3
|
my $pragma = shift; |
110
|
|
|
|
|
|
|
|
111
|
3
|
|
66
|
|
|
11
|
$CASE_INSENSITIVE = defined $pragma && $pragma eq ':case-insensitive'; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# make aliases from $mth->is_http-method-name to $mth->is_HTTP-METHOD-NAME |
114
|
3
|
100
|
|
|
|
1832
|
if ($CASE_INSENSITIVE) { |
115
|
|
|
|
|
|
|
|
116
|
3
|
|
|
3
|
|
397
|
no strict 'refs'; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
657
|
|
117
|
|
|
|
|
|
|
|
118
|
1
|
|
|
|
|
2
|
foreach my $token (keys %METHOD) { |
119
|
9
|
|
|
|
|
7
|
my $predicate = 'is_' . $token; |
120
|
9
|
|
|
|
|
8
|
my $alias = lc $predicate; |
121
|
9
|
|
|
|
|
17
|
*$alias = *$predicate; |
122
|
9
|
|
|
|
|
1782
|
undef *$predicate; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head2 new |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Creates a new HTTP::Method object. It takes only 1 argument, a HTTP-METHOD-NAME. |
130
|
|
|
|
|
|
|
It must be one of the methods defined in L
|
131
|
|
|
|
|
|
|
Definitions|https://tools.ietf.org/html/rfc7231#section-4.3>. Valid names are: |
132
|
|
|
|
|
|
|
C, C, C, C, C, C, C and C |
133
|
|
|
|
|
|
|
and additionally C. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
If used with C<:case-insensitive> one can use lowercase names as well. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=cut |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub new { |
140
|
18
|
|
|
18
|
1
|
30292
|
my $class = shift; |
141
|
18
|
50
|
|
|
|
41
|
my $http_method_name = shift or carp "missing http-method-name"; |
142
|
18
|
100
|
|
|
|
36
|
$http_method_name = uc $http_method_name if $CASE_INSENSITIVE; |
143
|
|
|
|
|
|
|
croak "unknown http-method-name: '$http_method_name'" |
144
|
18
|
50
|
|
|
|
38
|
unless exists $METHOD{ $http_method_name }; |
145
|
18
|
|
|
|
|
41
|
return bless \$http_method_name, $class |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 METHODS |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head2 is_method_safe |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
From L |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
Request methods are considered "safe" if their defined semantics are |
155
|
|
|
|
|
|
|
essentially read-only; i.e., the client does not request, and does |
156
|
|
|
|
|
|
|
not expect, any state change on the origin server as a result of |
157
|
|
|
|
|
|
|
applying a safe method to a target resource. Likewise, reasonable |
158
|
|
|
|
|
|
|
use of a safe method is not expected to cause any harm, loss of |
159
|
|
|
|
|
|
|
property, or unusual burden on the origin server. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=cut |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub is_method_safe { |
164
|
18
|
|
|
18
|
1
|
20
|
my $self = shift; |
165
|
|
|
|
|
|
|
return $METHOD{$$self}{is_safe} |
166
|
18
|
|
|
|
|
89
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head2 is_method_idempotent |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
From L |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
A request method is considered "idempotent" if the intended effect on |
173
|
|
|
|
|
|
|
the server of multiple identical requests with that method is the |
174
|
|
|
|
|
|
|
same as the effect for a single such request. Of the request methods |
175
|
|
|
|
|
|
|
defined by this specification, PUT, DELETE, and safe request methods |
176
|
|
|
|
|
|
|
are idempotent. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=cut |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub is_method_idempotent { |
181
|
18
|
|
|
18
|
1
|
19
|
my $self = shift; |
182
|
|
|
|
|
|
|
return $METHOD{$$self}{is_idempotent} |
183
|
18
|
|
|
|
|
65
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=head2 is_method_cachable |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
From L |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Request methods can be defined as "cacheable" to indicate that |
190
|
|
|
|
|
|
|
responses to them are allowed to be stored for future reuse; for |
191
|
|
|
|
|
|
|
specific requirements see [RFC7234]. In general, safe methods that |
192
|
|
|
|
|
|
|
do not depend on a current or authoritative response are defined as |
193
|
|
|
|
|
|
|
cacheable; this specification defines GET, HEAD, and POST as |
194
|
|
|
|
|
|
|
cacheable, although the overwhelming majority of cache |
195
|
|
|
|
|
|
|
implementations only support GET and HEAD. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=cut |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub is_method_cachable { |
200
|
18
|
|
|
18
|
1
|
21
|
my $self = shift; |
201
|
|
|
|
|
|
|
return $METHOD{$$self}{is_cachable} |
202
|
18
|
|
|
|
|
76
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub _to_string { |
205
|
18
|
|
|
18
|
|
22
|
my $self = shift; |
206
|
18
|
|
|
|
|
61
|
return $$self; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=head1 ALTERNATIVE INSTANTIATION |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
C objects have an alternative way of instantiation. These help |
212
|
|
|
|
|
|
|
building more robust code. You can use C for |
213
|
|
|
|
|
|
|
most HTTP methods like |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
my $mth = HTTP::Method::HTTP-METHOD-NAME(); |
216
|
|
|
|
|
|
|
# non OOP |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
use the OOP constructors: |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
my $mth = HTTP::Method->HTTP-METHOD-NAME |
221
|
|
|
|
|
|
|
# prefered way |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
instead of |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
my $mth = HTTP::Method->new(uc 'http-method-name') |
226
|
|
|
|
|
|
|
# don't do this |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
The list below shows which are available: |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=over |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=item HTTP::Method::CONNECT |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=item HTTP::Method::DELETE |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=item HTTP::Method::GET |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=item HTTP::Method::HEAD |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item HTTP::Method::OPTIONS |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=item HTTP::Method::PATCH |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=item HTTP::Method::POST |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=item HTTP::Method::PUT |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item HTTP::Method::TRACE |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=back |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=cut |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# create for all the known HTTP Methods in the matrix two methods: |
255
|
|
|
|
|
|
|
# - HTTP::Method::HTTP-METHOD-NAME |
256
|
|
|
|
|
|
|
# a constructor so that we can call for example HTTP::Method->POST |
257
|
|
|
|
|
|
|
# - is_HTTP-METHOD-NAME |
258
|
|
|
|
|
|
|
# a predicate to test if a method is a certain name |
259
|
|
|
|
|
|
|
# :case-insensitive will rename these to lowercase method names |
260
|
|
|
|
|
|
|
# is_http-method-name |
261
|
|
|
|
|
|
|
# |
262
|
|
|
|
|
|
|
{ |
263
|
3
|
|
|
3
|
|
12
|
no strict 'refs'; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
331
|
|
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
foreach my $http_method_name (keys %METHOD) { |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
my $construct = $http_method_name; |
268
|
|
|
|
|
|
|
*$construct = sub { |
269
|
18
|
|
|
18
|
|
97
|
return bless \$http_method_name, __PACKAGE__ |
270
|
|
|
|
|
|
|
}; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
my $predicate = 'is_' . $http_method_name; |
273
|
|
|
|
|
|
|
$predicate = lc $predicate if $CASE_INSENSITIVE; |
274
|
|
|
|
|
|
|
*$predicate = sub { |
275
|
36
|
|
|
36
|
|
39
|
my $self = shift; |
276
|
36
|
|
|
|
|
170
|
return $$self eq $http_method_name |
277
|
|
|
|
|
|
|
}; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=head1 CAVEATS |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=head2 Case-Insensitive |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
According to RFC 7231, SECTION 4.1 method tokens are case sensitive, unlike what |
286
|
|
|
|
|
|
|
most developers think it is. This might be surprising and will become very |
287
|
|
|
|
|
|
|
inconvenient if we had to think about it too much. |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
use HTTP::Method ':case-insensitive'; |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
Using the module this way will make it behave like we are most familiar with. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
C<< HTTP::Method->new($string) >> |
294
|
|
|
|
|
|
|
creates a new HTTP::Method object that will always have an uppercase name. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
C<< $mth = HTTP::Method->HTTP-METHOD-NAME >> |
297
|
|
|
|
|
|
|
factory methods will be uppercased. |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
C<< $mth->is_http-method-name >> |
300
|
|
|
|
|
|
|
predicate methods are lowercased |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
C<< "$mth" >> always stringfies to uppercase |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
If one does NOT use the C The above behaviour will |
305
|
|
|
|
|
|
|
not be swithced on, resulting in some I |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
my $str = 'get'; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
my $mth = HTTP::Method->new($str); |
310
|
|
|
|
|
|
|
# croak "unknown method" |
311
|
|
|
|
|
|
|
# only uppercase http-method-names |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
warn "case-sensitive" if $mth ne HTTP::Method->GET; |
314
|
|
|
|
|
|
|
# $mth stringifies to original $str |
315
|
|
|
|
|
|
|
# HTTP::Method->GET eq "GET" |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
$mth->is_get; # undefined method |
318
|
|
|
|
|
|
|
# predicates are spelled according |
319
|
|
|
|
|
|
|
# to normilization, uppercase |
320
|
|
|
|
|
|
|
# |
321
|
|
|
|
|
|
|
# $mth eq "get" |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
$mth->is_GET; # undef |
324
|
|
|
|
|
|
|
# the internal token is lowercase |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
$mth->is_method_cachable # undef |
327
|
|
|
|
|
|
|
# 'get' is unknown to the RFC |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
Most of those could had been solved with passin in the right arument into the |
330
|
|
|
|
|
|
|
constructor, using C like in |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
my $mth = HTTP::Method->new(uc $str); |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
print "$mth"; # GET |
335
|
|
|
|
|
|
|
$mth->is_GET; # 1 |
336
|
|
|
|
|
|
|
$mth->is_method_cachable; # 1 |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=cut |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
Thank you Adam for inspiring me to write better readable code (don't look inside |
343
|
|
|
|
|
|
|
the source!) |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=head1 AUTHOR |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
Th. J. van Hoesel |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=head1 SEE ALSO |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=over |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=item RFC-7231 |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=back |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=cut |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
1; |