1 | package Mojo::Parameters;
|
---|
2 | use Mojo::Base -base;
|
---|
3 | use overload
|
---|
4 | '@{}' => sub { shift->pairs },
|
---|
5 | bool => sub {1},
|
---|
6 | '""' => sub { shift->to_string },
|
---|
7 | fallback => 1;
|
---|
8 |
|
---|
9 | use Mojo::Util qw(decode encode url_escape url_unescape);
|
---|
10 |
|
---|
11 | has charset => 'UTF-8';
|
---|
12 |
|
---|
13 | sub append {
|
---|
14 | my $self = shift;
|
---|
15 |
|
---|
16 | my $old = $self->pairs;
|
---|
17 | my @new = @_ == 1 ? @{shift->pairs} : @_;
|
---|
18 | while (my ($name, $value) = splice @new, 0, 2) {
|
---|
19 |
|
---|
20 | # Multiple values
|
---|
21 | if (ref $value eq 'ARRAY') { push @$old, $name => $_ // '' for @$value }
|
---|
22 |
|
---|
23 | # Single value
|
---|
24 | elsif (defined $value) { push @$old, $name => $value }
|
---|
25 | }
|
---|
26 |
|
---|
27 | return $self;
|
---|
28 | }
|
---|
29 |
|
---|
30 | sub clone {
|
---|
31 | my $self = shift;
|
---|
32 |
|
---|
33 | my $clone = $self->new;
|
---|
34 | if (exists $self->{charset}) { $clone->{charset} = $self->{charset} }
|
---|
35 | if (defined $self->{string}) { $clone->{string} = $self->{string} }
|
---|
36 | else { $clone->{pairs} = [@{$self->pairs}] }
|
---|
37 |
|
---|
38 | return $clone;
|
---|
39 | }
|
---|
40 |
|
---|
41 | sub every_param {
|
---|
42 | my ($self, $name) = @_;
|
---|
43 |
|
---|
44 | my @values;
|
---|
45 | my $pairs = $self->pairs;
|
---|
46 | for (my $i = 0; $i < @$pairs; $i += 2) {
|
---|
47 | push @values, $pairs->[$i + 1] if $pairs->[$i] eq $name;
|
---|
48 | }
|
---|
49 |
|
---|
50 | return \@values;
|
---|
51 | }
|
---|
52 |
|
---|
53 | sub merge {
|
---|
54 | my $self = shift;
|
---|
55 |
|
---|
56 | my @pairs = @_ == 1 ? @{shift->pairs} : @_;
|
---|
57 | while (my ($name, $value) = splice @pairs, 0, 2) {
|
---|
58 | defined $value ? $self->param($name => $value) : $self->remove($name);
|
---|
59 | }
|
---|
60 |
|
---|
61 | return $self;
|
---|
62 | }
|
---|
63 |
|
---|
64 | sub names { [sort keys %{shift->to_hash}] }
|
---|
65 |
|
---|
66 | sub new { @_ > 1 ? shift->SUPER::new->parse(@_) : shift->SUPER::new }
|
---|
67 |
|
---|
68 | sub pairs {
|
---|
69 | my $self = shift;
|
---|
70 |
|
---|
71 | # Replace parameters
|
---|
72 | if (@_) {
|
---|
73 | $self->{pairs} = shift;
|
---|
74 | delete $self->{string};
|
---|
75 | return $self;
|
---|
76 | }
|
---|
77 |
|
---|
78 | # Parse string
|
---|
79 | if (defined(my $str = delete $self->{string})) {
|
---|
80 | my $pairs = $self->{pairs} = [];
|
---|
81 | return $pairs unless length $str;
|
---|
82 |
|
---|
83 | my $charset = $self->charset;
|
---|
84 | for my $pair (split '&', $str) {
|
---|
85 | next unless $pair =~ /^([^=]+)(?:=(.*))?$/;
|
---|
86 | my ($name, $value) = ($1, $2 // '');
|
---|
87 |
|
---|
88 | # Replace "+" with whitespace, unescape and decode
|
---|
89 | s/\+/ /g for $name, $value;
|
---|
90 | $name = url_unescape $name;
|
---|
91 | $name = decode($charset, $name) // $name if $charset;
|
---|
92 | $value = url_unescape $value;
|
---|
93 | $value = decode($charset, $value) // $value if $charset;
|
---|
94 |
|
---|
95 | push @$pairs, $name, $value;
|
---|
96 | }
|
---|
97 | }
|
---|
98 |
|
---|
99 | return $self->{pairs} ||= [];
|
---|
100 | }
|
---|
101 |
|
---|
102 | sub param {
|
---|
103 | my ($self, $name) = (shift, shift);
|
---|
104 | return $self->every_param($name)->[-1] unless @_;
|
---|
105 | $self->remove($name);
|
---|
106 | return $self->append($name => ref $_[0] eq 'ARRAY' ? $_[0] : [@_]);
|
---|
107 | }
|
---|
108 |
|
---|
109 | sub parse {
|
---|
110 | my $self = shift;
|
---|
111 |
|
---|
112 | # Pairs
|
---|
113 | return $self->append(@_) if @_ > 1;
|
---|
114 |
|
---|
115 | # String
|
---|
116 | $self->{string} = shift;
|
---|
117 | return $self;
|
---|
118 | }
|
---|
119 |
|
---|
120 | sub remove {
|
---|
121 | my ($self, $name) = @_;
|
---|
122 | my $pairs = $self->pairs;
|
---|
123 | my $i = 0;
|
---|
124 | $pairs->[$i] eq $name ? splice @$pairs, $i, 2 : ($i += 2) while $i < @$pairs;
|
---|
125 | return $self;
|
---|
126 | }
|
---|
127 |
|
---|
128 | sub to_hash {
|
---|
129 | my $self = shift;
|
---|
130 |
|
---|
131 | my %hash;
|
---|
132 | my $pairs = $self->pairs;
|
---|
133 | for (my $i = 0; $i < @$pairs; $i += 2) {
|
---|
134 | my ($name, $value) = @{$pairs}[$i, $i + 1];
|
---|
135 |
|
---|
136 | # Array
|
---|
137 | if (exists $hash{$name}) {
|
---|
138 | $hash{$name} = [$hash{$name}] if ref $hash{$name} ne 'ARRAY';
|
---|
139 | push @{$hash{$name}}, $value;
|
---|
140 | }
|
---|
141 |
|
---|
142 | # String
|
---|
143 | else { $hash{$name} = $value }
|
---|
144 | }
|
---|
145 |
|
---|
146 | return \%hash;
|
---|
147 | }
|
---|
148 |
|
---|
149 | sub to_string {
|
---|
150 | my $self = shift;
|
---|
151 |
|
---|
152 | # String (RFC 3986)
|
---|
153 | my $charset = $self->charset;
|
---|
154 | if (defined(my $str = $self->{string})) {
|
---|
155 | $str = encode $charset, $str if $charset;
|
---|
156 | return url_escape $str, '^A-Za-z0-9\-._~%!$&\'()*+,;=:@/?';
|
---|
157 | }
|
---|
158 |
|
---|
159 | # Build pairs (HTML Living Standard)
|
---|
160 | my $pairs = $self->pairs;
|
---|
161 | return '' unless @$pairs;
|
---|
162 | my @pairs;
|
---|
163 | for (my $i = 0; $i < @$pairs; $i += 2) {
|
---|
164 | my ($name, $value) = @{$pairs}[$i, $i + 1];
|
---|
165 |
|
---|
166 | # Escape and replace whitespace with "+"
|
---|
167 | $name = encode $charset, $name if $charset;
|
---|
168 | $name = url_escape $name, '^*\-.0-9A-Z_a-z';
|
---|
169 | $value = encode $charset, $value if $charset;
|
---|
170 | $value = url_escape $value, '^*\-.0-9A-Z_a-z';
|
---|
171 | s/\%20/\+/g for $name, $value;
|
---|
172 |
|
---|
173 | push @pairs, "$name=$value";
|
---|
174 | }
|
---|
175 |
|
---|
176 | return join '&', @pairs;
|
---|
177 | }
|
---|
178 |
|
---|
179 | 1;
|
---|
180 |
|
---|
181 | =encoding utf8
|
---|
182 |
|
---|
183 | =head1 NAME
|
---|
184 |
|
---|
185 | Mojo::Parameters - Parameters
|
---|
186 |
|
---|
187 | =head1 SYNOPSIS
|
---|
188 |
|
---|
189 | use Mojo::Parameters;
|
---|
190 |
|
---|
191 | # Parse
|
---|
192 | my $params = Mojo::Parameters->new('foo=bar&baz=23');
|
---|
193 | say $params->param('baz');
|
---|
194 |
|
---|
195 | # Build
|
---|
196 | my $params = Mojo::Parameters->new(foo => 'bar', baz => 23);
|
---|
197 | push @$params, i => '⥠mojolicious';
|
---|
198 | say "$params";
|
---|
199 |
|
---|
200 | =head1 DESCRIPTION
|
---|
201 |
|
---|
202 | L<Mojo::Parameters> is a container for form parameters used by L<Mojo::URL>,
|
---|
203 | based on L<RFC 3986|http://tools.ietf.org/html/rfc3986> and the
|
---|
204 | L<HTML Living Standard|https://html.spec.whatwg.org>.
|
---|
205 |
|
---|
206 | =head1 ATTRIBUTES
|
---|
207 |
|
---|
208 | L<Mojo::Parameters> implements the following attributes.
|
---|
209 |
|
---|
210 | =head2 charset
|
---|
211 |
|
---|
212 | my $charset = $params->charset;
|
---|
213 | $params = $params->charset('UTF-8');
|
---|
214 |
|
---|
215 | Charset used for encoding and decoding parameters, defaults to C<UTF-8>.
|
---|
216 |
|
---|
217 | # Disable encoding and decoding
|
---|
218 | $params->charset(undef);
|
---|
219 |
|
---|
220 | =head1 METHODS
|
---|
221 |
|
---|
222 | L<Mojo::Parameters> inherits all methods from L<Mojo::Base> and implements the
|
---|
223 | following new ones.
|
---|
224 |
|
---|
225 | =head2 append
|
---|
226 |
|
---|
227 | $params = $params->append(foo => 'ba&r');
|
---|
228 | $params = $params->append(foo => ['ba&r', 'baz']);
|
---|
229 | $params = $params->append(foo => ['bar', 'baz'], bar => 23);
|
---|
230 | $params = $params->append(Mojo::Parameters->new);
|
---|
231 |
|
---|
232 | Append parameters. Note that this method will normalize the parameters.
|
---|
233 |
|
---|
234 | # "foo=bar&foo=baz"
|
---|
235 | Mojo::Parameters->new('foo=bar')->append(Mojo::Parameters->new('foo=baz'));
|
---|
236 |
|
---|
237 | # "foo=bar&foo=baz"
|
---|
238 | Mojo::Parameters->new('foo=bar')->append(foo => 'baz');
|
---|
239 |
|
---|
240 | # "foo=bar&foo=baz&foo=yada"
|
---|
241 | Mojo::Parameters->new('foo=bar')->append(foo => ['baz', 'yada']);
|
---|
242 |
|
---|
243 | # "foo=bar&foo=baz&foo=yada&bar=23"
|
---|
244 | Mojo::Parameters->new('foo=bar')->append(foo => ['baz', 'yada'], bar => 23);
|
---|
245 |
|
---|
246 | =head2 clone
|
---|
247 |
|
---|
248 | my $params2 = $params->clone;
|
---|
249 |
|
---|
250 | Return a new L<Mojo::Parameters> object cloned from these parameters.
|
---|
251 |
|
---|
252 | =head2 every_param
|
---|
253 |
|
---|
254 | my $values = $params->every_param('foo');
|
---|
255 |
|
---|
256 | Similar to L</"param">, but returns all values sharing the same name as an
|
---|
257 | array reference. Note that this method will normalize the parameters.
|
---|
258 |
|
---|
259 | # Get first value
|
---|
260 | say $params->every_param('foo')->[0];
|
---|
261 |
|
---|
262 | =head2 merge
|
---|
263 |
|
---|
264 | $params = $params->merge(foo => 'ba&r');
|
---|
265 | $params = $params->merge(foo => ['ba&r', 'baz']);
|
---|
266 | $params = $params->merge(foo => ['bar', 'baz'], bar => 23);
|
---|
267 | $params = $params->merge(Mojo::Parameters->new);
|
---|
268 |
|
---|
269 | Merge parameters. Note that this method will normalize the parameters.
|
---|
270 |
|
---|
271 | # "foo=baz"
|
---|
272 | Mojo::Parameters->new('foo=bar')->merge(Mojo::Parameters->new('foo=baz'));
|
---|
273 |
|
---|
274 | # "yada=yada&foo=baz"
|
---|
275 | Mojo::Parameters->new('foo=bar&yada=yada')->merge(foo => 'baz');
|
---|
276 |
|
---|
277 | # "yada=yada"
|
---|
278 | Mojo::Parameters->new('foo=bar&yada=yada')->merge(foo => undef);
|
---|
279 |
|
---|
280 | =head2 names
|
---|
281 |
|
---|
282 | my $names = $params->names;
|
---|
283 |
|
---|
284 | Return an array reference with all parameter names.
|
---|
285 |
|
---|
286 | # Names of all parameters
|
---|
287 | say for @{$params->names};
|
---|
288 |
|
---|
289 | =head2 new
|
---|
290 |
|
---|
291 | my $params = Mojo::Parameters->new;
|
---|
292 | my $params = Mojo::Parameters->new('foo=b%3Bar&baz=23');
|
---|
293 | my $params = Mojo::Parameters->new(foo => 'b&ar');
|
---|
294 | my $params = Mojo::Parameters->new(foo => ['ba&r', 'baz']);
|
---|
295 | my $params = Mojo::Parameters->new(foo => ['bar', 'baz'], bar => 23);
|
---|
296 |
|
---|
297 | Construct a new L<Mojo::Parameters> object and L</"parse"> parameters if
|
---|
298 | necessary.
|
---|
299 |
|
---|
300 | =head2 pairs
|
---|
301 |
|
---|
302 | my $array = $params->pairs;
|
---|
303 | $params = $params->pairs([foo => 'b&ar', baz => 23]);
|
---|
304 |
|
---|
305 | Parsed parameter pairs. Note that this method will normalize the parameters.
|
---|
306 |
|
---|
307 | # Remove all parameters
|
---|
308 | $params->pairs([]);
|
---|
309 |
|
---|
310 | =head2 param
|
---|
311 |
|
---|
312 | my $value = $params->param('foo');
|
---|
313 | $params = $params->param(foo => 'ba&r');
|
---|
314 | $params = $params->param(foo => qw(ba&r baz));
|
---|
315 | $params = $params->param(foo => ['ba;r', 'baz']);
|
---|
316 |
|
---|
317 | Access parameter values. If there are multiple values sharing the same name,
|
---|
318 | and you want to access more than just the last one, you can use
|
---|
319 | L</"every_param">. Note that this method will normalize the parameters.
|
---|
320 |
|
---|
321 | =head2 parse
|
---|
322 |
|
---|
323 | $params = $params->parse('foo=b%3Bar&baz=23');
|
---|
324 |
|
---|
325 | Parse parameters.
|
---|
326 |
|
---|
327 | =head2 remove
|
---|
328 |
|
---|
329 | $params = $params->remove('foo');
|
---|
330 |
|
---|
331 | Remove parameters. Note that this method will normalize the parameters.
|
---|
332 |
|
---|
333 | # "bar=yada"
|
---|
334 | Mojo::Parameters->new('foo=bar&foo=baz&bar=yada')->remove('foo');
|
---|
335 |
|
---|
336 | =head2 to_hash
|
---|
337 |
|
---|
338 | my $hash = $params->to_hash;
|
---|
339 |
|
---|
340 | Turn parameters into a hash reference. Note that this method will normalize the
|
---|
341 | parameters.
|
---|
342 |
|
---|
343 | # "baz"
|
---|
344 | Mojo::Parameters->new('foo=bar&foo=baz')->to_hash->{foo}[1];
|
---|
345 |
|
---|
346 | =head2 to_string
|
---|
347 |
|
---|
348 | my $str = $params->to_string;
|
---|
349 |
|
---|
350 | Turn parameters into a string.
|
---|
351 |
|
---|
352 | # "foo=bar&baz=23"
|
---|
353 | Mojo::Parameters->new->pairs([foo => 'bar', baz => 23])->to_string;
|
---|
354 |
|
---|
355 | =head1 OPERATORS
|
---|
356 |
|
---|
357 | L<Mojo::Parameters> overloads the following operators.
|
---|
358 |
|
---|
359 | =head2 array
|
---|
360 |
|
---|
361 | my @pairs = @$params;
|
---|
362 |
|
---|
363 | Alias for L</"pairs">. Note that this will normalize the parameters.
|
---|
364 |
|
---|
365 | say $params->[0];
|
---|
366 | say for @$params;
|
---|
367 |
|
---|
368 | =head2 bool
|
---|
369 |
|
---|
370 | my $bool = !!$params;
|
---|
371 |
|
---|
372 | Always true.
|
---|
373 |
|
---|
374 | =head2 stringify
|
---|
375 |
|
---|
376 | my $str = "$params";
|
---|
377 |
|
---|
378 | Alias for L</"to_string">.
|
---|
379 |
|
---|
380 | =head1 SEE ALSO
|
---|
381 |
|
---|
382 | L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
---|
383 |
|
---|
384 | =cut
|
---|