line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::FormValidator::Constraints::HTTP;
|
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
236071
|
use strict;
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
88
|
|
4
|
2
|
|
|
2
|
|
11
|
use warnings;
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
84
|
|
5
|
2
|
|
|
2
|
|
13
|
use base qw( Exporter );
|
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
932
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.01';
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our @EXPORT_OK = qw(
|
10
|
|
|
|
|
|
|
http_method
|
11
|
|
|
|
|
|
|
DELETE
|
12
|
|
|
|
|
|
|
GET
|
13
|
|
|
|
|
|
|
OPTIONS
|
14
|
|
|
|
|
|
|
POST
|
15
|
|
|
|
|
|
|
PUT
|
16
|
|
|
|
|
|
|
TRACE
|
17
|
|
|
|
|
|
|
);
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 NAME
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
Data::FormValidator::Constraints::HTTP - Simple Data::FormValidator
|
22
|
|
|
|
|
|
|
constraint methods for checking various HTTP methods.
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
use Data::FormValidator;
|
28
|
|
|
|
|
|
|
use Data::FormValidator::Constraints::HTTP qw( POST );
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
my %input = (
|
31
|
|
|
|
|
|
|
method => $request->method,
|
32
|
|
|
|
|
|
|
author => $request->parameter('author'),
|
33
|
|
|
|
|
|
|
name => $request->parameter('name'),
|
34
|
|
|
|
|
|
|
);
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my %profile = (
|
37
|
|
|
|
|
|
|
required => [ qw( method author ) ],
|
38
|
|
|
|
|
|
|
optional => [ qw( name ) ],
|
39
|
|
|
|
|
|
|
constraint_methods => {
|
40
|
|
|
|
|
|
|
method => POST,
|
41
|
|
|
|
|
|
|
},
|
42
|
|
|
|
|
|
|
);
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $results = Data::FormValidator->check( \%input, \%profile );
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# If $request->method was not 'POST', then this form validation
|
47
|
|
|
|
|
|
|
# will not be successful.
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
This module provides some simple, Data::FormValidator compatible
|
53
|
|
|
|
|
|
|
constraint methods for validating HTTP request methods. For example,
|
54
|
|
|
|
|
|
|
it may be desirable to consider a form invalid until the request method
|
55
|
|
|
|
|
|
|
is POST.
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 INTEGRATION WITH THE CATALYST WEB FRAMEWORK
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
I have found this technique of making forms invalid unless the request
|
60
|
|
|
|
|
|
|
method is POST to be rather useful within the Catalyst web framework,
|
61
|
|
|
|
|
|
|
using the FormValidator and FillInForm plugins.
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
The FillInForm plugin will automatically fill in an HTML form with the
|
64
|
|
|
|
|
|
|
values located in $c->request->parameters *AS LONG AS THE CURRENT FORM
|
65
|
|
|
|
|
|
|
IS INVALID*. We can use this behaviour to make our lives simpler. By
|
66
|
|
|
|
|
|
|
placing the HTTP method constraint method in our validation profile,
|
67
|
|
|
|
|
|
|
we can be guaranteed that FillInForm will engage if the method is not
|
68
|
|
|
|
|
|
|
POST (it may still engage even if the method *IS* POST, depending on
|
69
|
|
|
|
|
|
|
the form validation profile and the client's provided input).
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
package My::App;
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
use Catalyst qw( Static::Simple FillInForm FormValidator );
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
1;
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
...
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
package My::App::Controller::Root;
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
use base qw( Catalyst::Controller );
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub auto : Private {
|
89
|
|
|
|
|
|
|
my ($self, $c) = @_;
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# The HTTP request method must be placed into the request
|
92
|
|
|
|
|
|
|
# parameters in order for the FormValidator plugin to check it.
|
93
|
|
|
|
|
|
|
# This can easily be done in the root controller's "auto"
|
94
|
|
|
|
|
|
|
# action to avoid this in the various controllers.
|
95
|
|
|
|
|
|
|
# Just another tip to make the code cleaner. :)
|
96
|
|
|
|
|
|
|
$c->request->parameter( method => $c->request->method );
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
1;
|
99
|
|
|
|
|
|
|
}
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
1;
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
...
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
package My::App::Controller::Foo;
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
use Data::FormValidator::Constraints::HTTP qw( POST );
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub update : Local {
|
114
|
|
|
|
|
|
|
my ($self, $c, $foo) = @_;
|
115
|
|
|
|
|
|
|
$foo = $c->model('Schema::Foo')->find( $foo );
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
$c->form(
|
118
|
|
|
|
|
|
|
required => [ qw( method name author ) ],
|
119
|
|
|
|
|
|
|
constraint_methods => {
|
120
|
|
|
|
|
|
|
method => POST,
|
121
|
|
|
|
|
|
|
name => FV_min_length( 6 ),
|
122
|
|
|
|
|
|
|
# ... yadda, yadda, yadda
|
123
|
|
|
|
|
|
|
},
|
124
|
|
|
|
|
|
|
);
|
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
if ($c->form->success) {
|
127
|
|
|
|
|
|
|
# you can be sure this will only be reached if the request
|
128
|
|
|
|
|
|
|
# method is POST and the rest of the request parameters
|
129
|
|
|
|
|
|
|
# have successfully passed the rest of your form validation
|
130
|
|
|
|
|
|
|
# profile.
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
$foo->update_from_form( $c->form );
|
133
|
|
|
|
|
|
|
}
|
134
|
|
|
|
|
|
|
else {
|
135
|
|
|
|
|
|
|
# By setting the parameters in this manner, FillInForm will
|
136
|
|
|
|
|
|
|
# automatically fill in the HTML form using the current
|
137
|
|
|
|
|
|
|
# object values, being overridden by any request parameters
|
138
|
|
|
|
|
|
|
# already specified. Meaning, if $foo get a field called
|
139
|
|
|
|
|
|
|
# 'title' and its value had already been set, FillInForm
|
140
|
|
|
|
|
|
|
# will place that value into the HTML form being presented
|
141
|
|
|
|
|
|
|
# to the client. However, if the request parameters include
|
142
|
|
|
|
|
|
|
# a value for 'title', *THAT* value gets placed in the
|
143
|
|
|
|
|
|
|
# HTML form.
|
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
$c->request->parameters({
|
146
|
|
|
|
|
|
|
$foo->get_columns,
|
147
|
|
|
|
|
|
|
%{ $c->request->parameters },
|
148
|
|
|
|
|
|
|
});
|
149
|
|
|
|
|
|
|
}
|
150
|
|
|
|
|
|
|
}
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
1;
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head1 METHODS
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head2 http_method ( $method )
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Returns a constraint method to determine whether or not a method is
|
160
|
|
|
|
|
|
|
equal to the provided variable.
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head2 DELETE ( )
|
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head2 GET ( )
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head2 OPTIONS ( )
|
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head2 POST ( )
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head2 PUT ( )
|
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=head2 TRACE ( )
|
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Returns a constraint method to determine whether or not a method is
|
175
|
|
|
|
|
|
|
equal to the name of the rule (i.e. - GET, POST, PUT, etc...).
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=cut
|
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub http_method {
|
180
|
1
|
|
|
1
|
1
|
3
|
my $method = shift;
|
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
return sub {
|
183
|
6
|
|
|
6
|
|
12664
|
my $dfv = shift;
|
184
|
|
|
|
|
|
|
|
185
|
6
|
|
|
|
|
24
|
$dfv->name_this('method');
|
186
|
|
|
|
|
|
|
|
187
|
6
|
|
|
|
|
42
|
my $value = $dfv->get_current_constraint_value; |
188
|
|
|
|
|
|
|
|
189
|
6
|
100
|
66
|
|
|
73
|
if ($value and lc $value eq lc $method) {
|
190
|
3
|
|
|
|
|
9
|
return 1;
|
191
|
|
|
|
|
|
|
}
|
192
|
|
|
|
|
|
|
else {
|
193
|
3
|
|
|
|
|
10
|
return 0;
|
194
|
|
|
|
|
|
|
} |
195
|
1
|
|
|
|
|
14
|
};
|
196
|
|
|
|
|
|
|
}
|
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
0
|
|
0
|
sub DELETE { http_method('DELETE') }
|
199
|
0
|
|
|
0
|
1
|
0
|
sub GET { http_method('GET') }
|
200
|
0
|
|
|
0
|
1
|
0
|
sub OPTIONS { http_method('OPTIONS') }
|
201
|
1
|
|
|
1
|
1
|
282
|
sub POST { http_method('POST') }
|
202
|
0
|
|
|
0
|
1
|
|
sub PUT { http_method('PUT') }
|
203
|
0
|
|
|
0
|
1
|
|
sub TRACE { http_method('TRACE') }
|
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head1 SEE ALSO
|
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=over 4
|
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=item * Data::FormValidator
|
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=item * Data::FormValidator::Constraints
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=item * Catalyst
|
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=back
|
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=head1 AUTHOR
|
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Adam Paynter Eadapay@cpan.orgE
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
Copyright 2006 by Adam Paynter
|
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
226
|
|
|
|
|
|
|
it under the same terms as Perl itself.
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=cut |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
1; |