use Mojo::Base -base;
'@{}' => sub { shift->pairs },
bool => sub {1},
'""' => sub { shift->to_string },
fallback => 1;
use Mojo::Util qw(decode encode url_escape url_unescape);
has charset => 'UTF-8';
sub append {
my $self = shift;
my $old = $self->pairs;
my @new = @_ == 1 ? @{shift->pairs} : @_;
while (my ($name, $value) = splice @new, 0, 2) {
# Multiple values
if (ref $value eq 'ARRAY') { push @$old, $name => $_ // '' for @$value }
# Single value
elsif (defined $value) { push @$old, $name => $value }
}
return $self;
}
sub clone {
my $self = shift;
my $clone = $self->new;
if (exists $self->{charset}) { $clone->{charset} = $self->{charset} }
if (defined $self->{string}) { $clone->{string} = $self->{string} }
else { $clone->{pairs} = [@{$self->pairs}] }
return $clone;
}
sub every_param {
my ($self, $name) = @_;
my @values;
my $pairs = $self->pairs;
for (my $i = 0; $i < @$pairs; $i += 2) {
push @values, $pairs->[$i + 1] if $pairs->[$i] eq $name;
}
return \@values;
}
sub merge {
my $self = shift;
my @pairs = @_ == 1 ? @{shift->pairs} : @_;
while (my ($name, $value) = splice @pairs, 0, 2) {
defined $value ? $self->param($name => $value) : $self->remove($name);
}
return $self;
}
sub names { [sort keys %{shift->to_hash}] }
sub new { @_ > 1 ? shift->SUPER::new->parse(@_) : shift->SUPER::new }
sub pairs {
my $self = shift;
# Replace parameters
if (@_) {
$self->{pairs} = shift;
delete $self->{string};
return $self;
}
# Parse string
if (defined(my $str = delete $self->{string})) {
my $pairs = $self->{pairs} = [];
return $pairs unless length $str;
my $charset = $self->charset;
for my $pair (split '&', $str) {
next unless $pair =~ /^([^=]+)(?:=(.*))?$/;
my ($name, $value) = ($1, $2 // '');
# Replace "+" with whitespace, unescape and decode
s/\+/ /g for $name, $value;
$name = url_unescape $name;
$name = decode($charset, $name) // $name if $charset;
$value = url_unescape $value;
$value = decode($charset, $value) // $value if $charset;
push @$pairs, $name, $value;
}
}
return $self->{pairs} ||= [];
}
sub param {
my ($self, $name) = (shift, shift);
return $self->every_param($name)->[-1] unless @_;
$self->remove($name);
return $self->append($name => ref $_[0] eq 'ARRAY' ? $_[0] : [@_]);
}
sub parse {
my $self = shift;
# Pairs
return $self->append(@_) if @_ > 1;
# String
$self->{string} = shift;
return $self;
}
sub remove {
my ($self, $name) = @_;
my $pairs = $self->pairs;
my $i = 0;
$pairs->[$i] eq $name ? splice @$pairs, $i, 2 : ($i += 2) while $i < @$pairs;
return $self;
}
sub to_hash {
my $self = shift;
my %hash;
my $pairs = $self->pairs;
for (my $i = 0; $i < @$pairs; $i += 2) {
my ($name, $value) = @{$pairs}[$i, $i + 1];
# Array
if (exists $hash{$name}) {
$hash{$name} = [$hash{$name}] if ref $hash{$name} ne 'ARRAY';
push @{$hash{$name}}, $value;
}
# String
else { $hash{$name} = $value }
}
return \%hash;
}
sub to_string {
my $self = shift;
# String (RFC 3986)
my $charset = $self->charset;
if (defined(my $str = $self->{string})) {
$str = encode $charset, $str if $charset;
return url_escape $str, '^A-Za-z0-9\-._~%!$&\'()*+,;=:@/?';
}
# Build pairs (HTML Living Standard)
my $pairs = $self->pairs;
return '' unless @$pairs;
my @pairs;
for (my $i = 0; $i < @$pairs; $i += 2) {
my ($name, $value) = @{$pairs}[$i, $i + 1];
# Escape and replace whitespace with "+"
$name = encode $charset, $name if $charset;
$name = url_escape $name, '^*\-.0-9A-Z_a-z';
$value = encode $charset, $value if $charset;
$value = url_escape $value, '^*\-.0-9A-Z_a-z';
s/\%20/\+/g for $name, $value;
push @pairs, "$name=$value";
}
return join '&', @pairs;
}
1;
=encoding utf8
=head1 NAME
Mojo::Parameters - Parameters
=head1 SYNOPSIS
use Mojo::Parameters;
# Parse
my $params = Mojo::Parameters->new('foo=bar&baz=23');
say $params->param('baz');
# Build
my $params = Mojo::Parameters->new(foo => 'bar', baz => 23);
push @$params, i => '♥ mojolicious';
say "$params";
=head1 DESCRIPTION
L<Mojo::Parameters> is a container for form parameters used by L<Mojo::URL>,
based on L<RFC 3986|http://tools.ietf.org/html/rfc3986> and the
L<HTML Living Standard|https://html.spec.whatwg.org>.
=head1 ATTRIBUTES
L<Mojo::Parameters> implements the following attributes.
=head2 charset
my $charset = $params->charset;
$params = $params->charset('UTF-8');
Charset used for encoding and decoding parameters, defaults to C<UTF-8>.
# Disable encoding and decoding
$params->charset(undef);
=head1 METHODS
L<Mojo::Parameters> inherits all methods from L<Mojo::Base> and implements the
following new ones.
=head2 append
$params = $params->append(foo => 'ba&r');
$params = $params->append(foo => ['ba&r', 'baz']);
$params = $params->append(foo => ['bar', 'baz'], bar => 23);
$params = $params->append(Mojo::Parameters->new);
Append parameters. Note that this method will normalize the parameters.
# "foo=bar&foo=baz"
Mojo::Parameters->new('foo=bar')->append(Mojo::Parameters->new('foo=baz'));
# "foo=bar&foo=baz"
Mojo::Parameters->new('foo=bar')->append(foo => 'baz');
# "foo=bar&foo=baz&foo=yada"
Mojo::Parameters->new('foo=bar')->append(foo => ['baz', 'yada']);
# "foo=bar&foo=baz&foo=yada&bar=23"
Mojo::Parameters->new('foo=bar')->append(foo => ['baz', 'yada'], bar => 23);
=head2 clone
my $params2 = $params->clone;
Return a new L<Mojo::Parameters> object cloned from these parameters.
=head2 every_param
my $values = $params->every_param('foo');
Similar to L</"param">, but returns all values sharing the same name as an
array reference. Note that this method will normalize the parameters.
# Get first value
say $params->every_param('foo')->[0];
=head2 merge
$params = $params->merge(foo => 'ba&r');
$params = $params->merge(foo => ['ba&r', 'baz']);
$params = $params->merge(foo => ['bar', 'baz'], bar => 23);
$params = $params->merge(Mojo::Parameters->new);
Merge parameters. Note that this method will normalize the parameters.
# "foo=baz"
Mojo::Parameters->new('foo=bar')->merge(Mojo::Parameters->new('foo=baz'));
# "yada=yada&foo=baz"
Mojo::Parameters->new('foo=bar&yada=yada')->merge(foo => 'baz');
# "yada=yada"
Mojo::Parameters->new('foo=bar&yada=yada')->merge(foo => undef);
=head2 names
my $names = $params->names;
Return an array reference with all parameter names.
# Names of all parameters
say for @{$params->names};
=head2 new
my $params = Mojo::Parameters->new;
my $params = Mojo::Parameters->new('foo=b%3Bar&baz=23');
my $params = Mojo::Parameters->new(foo => 'b&ar');
my $params = Mojo::Parameters->new(foo => ['ba&r', 'baz']);
my $params = Mojo::Parameters->new(foo => ['bar', 'baz'], bar => 23);
Construct a new L<Mojo::Parameters> object and L</"parse"> parameters if
necessary.
=head2 pairs
my $array = $params->pairs;
$params = $params->pairs([foo => 'b&ar', baz => 23]);
Parsed parameter pairs. Note that this method will normalize the parameters.
# Remove all parameters
$params->pairs([]);
=head2 param
my $value = $params->param('foo');
$params = $params->param(foo => 'ba&r');
$params = $params->param(foo => qw(ba&r baz));
$params = $params->param(foo => ['ba;r', 'baz']);
Access parameter values. If there are multiple values sharing the same name,
and you want to access more than just the last one, you can use
L</"every_param">. Note that this method will normalize the parameters.
=head2 parse
$params = $params->parse('foo=b%3Bar&baz=23');
Parse parameters.
=head2 remove
$params = $params->remove('foo');
Remove parameters. Note that this method will normalize the parameters.
# "bar=yada"
Mojo::Parameters->new('foo=bar&foo=baz&bar=yada')->remove('foo');
=head2 to_hash
my $hash = $params->to_hash;
Turn parameters into a hash reference. Note that this method will normalize the
parameters.
# "baz"
Mojo::Parameters->new('foo=bar&foo=baz')->to_hash->{foo}[1];
=head2 to_string
my $str = $params->to_string;
Turn parameters into a string.
# "foo=bar&baz=23"
Mojo::Parameters->new->pairs([foo => 'bar', baz => 23])->to_string;
=head1 OPERATORS
L<Mojo::Parameters> overloads the following operators.
=head2 array
my @pairs = @$params;
Alias for L</"pairs">. Note that this will normalize the parameters.
say $params->[0];
say for @$params;
=head2 bool
my $bool = !!$params;
Always true.
=head2 stringify
my $str = "$params";
Alias for L</"to_string">.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
=cut