package Mojo::Parameters; use Mojo::Base -base; use overload '@{}' => sub { shift->params }, bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1; use Mojo::Util qw(decode encode url_escape url_unescape); has charset => 'UTF-8'; sub new { shift->SUPER::new->parse(@_) } sub append { my ($self, @pairs) = @_; my $params = $self->params; for (my $i = 0; $i < @pairs; $i += 2) { my $key = $pairs[$i] // ''; my $value = $pairs[$i + 1] // ''; # Single value if (ref $value ne 'ARRAY') { push @$params, $key => $value } # Multiple values else { push @$params, $key => (defined $_ ? "$_" : '') for @$value } } return $self; } sub clone { my $self = shift; my $clone = $self->new->charset($self->charset); if (defined $self->{string}) { $clone->{string} = $self->{string} } else { $clone->params([@{$self->params}]) } return $clone; } sub merge { my $self = shift; push @{$self->params}, @{$_->params} for @_; return $self; } sub param { my ($self, $name) = (shift, shift); # List names return sort keys %{$self->to_hash} unless $name; # Replace values $self->remove($name) if defined $_[0]; $self->append($name, $_) for @_; # List values my @values; my $params = $self->params; for (my $i = 0; $i < @$params; $i += 2) { push @values, $params->[$i + 1] if $params->[$i] eq $name; } return wantarray ? @values : $values[0]; } sub params { my $self = shift; # Replace parameters if (@_) { $self->{params} = shift; delete $self->{string}; return $self; } # Parse string if (defined(my $str = delete $self->{string})) { my $params = $self->{params} = []; return $params unless length $str; # W3C suggests to also accept ";" as a separator my $charset = $self->charset; for my $pair (split /&|;/, $str) { next unless $pair =~ /^([^=]+)(?:=(.*))?$/; my $name = $1; my $value = $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 @$params, $name, $value; } } return $self->{params} ||= []; } sub parse { my $self = shift; # Pairs if (@_ > 1) { $self->append(@_) } # String else { $self->{string} = $_[0] } return $self; } sub remove { my $self = shift; my $name = shift // ''; my $params = $self->params; for (my $i = 0; $i < @$params;) { if ($params->[$i] eq $name) { splice @$params, $i, 2 } else { $i += 2 } } return $self->params($params); } sub to_hash { my $self = shift; my $params = $self->params; my %hash; for (my $i = 0; $i < @$params; $i += 2) { my ($name, $value) = @{$params}[$i, $i + 1]; # Array if (exists $hash{$name}) { $hash{$name} = [$hash{$name}] unless ref $hash{$name} eq 'ARRAY'; push @{$hash{$name}}, $value; } # String else { $hash{$name} = $value } } return \%hash; } sub to_string { my $self = shift; # String 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 my $params = $self->params; return '' unless @$params; my @pairs; for (my $i = 0; $i < @$params; $i += 2) { my ($name, $value) = @{$params}[$i, $i + 1]; # Escape and replace whitespace with "+" $name = encode $charset, $name if $charset; $name = url_escape $name, '^A-Za-z0-9\-._~!$\'()*,:@/?'; $value = encode $charset, $value if $charset; $value = url_escape $value, '^A-Za-z0-9\-._~!$\'()*,:@/?'; 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 is a container for form parameters used by L. =head1 ATTRIBUTES L 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. # Disable encoding and decoding $params->charset(undef); =head1 METHODS L inherits all methods from L and implements the following new ones. =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', 'b;az']); my $params = Mojo::Parameters->new(foo => ['ba;r', 'b;az'], bar => 23); Construct a new L object and L parameters if necessary. =head2 append $params = $params->append(foo => 'ba;r'); $params = $params->append(foo => ['ba;r', 'b;az']); $params = $params->append(foo => ['ba;r', 'b;az'], bar => 23); Append parameters. Note that this method will normalize the parameters. # "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; Clone parameters. =head2 merge $params = $params->merge(Mojo::Parameters->new(foo => 'b;ar', baz => 23)); Merge L objects. Note that this method will normalize the parameters. =head2 param my @names = $params->param; my $foo = $params->param('foo'); my @foo = $params->param('foo'); my $foo = $params->param(foo => 'ba;r'); my @foo = $params->param(foo => qw(ba;r ba;z)); Check and replace parameter value. Be aware that if you request a parameter by name in scalar context, you will receive only the I value for that parameter, if there are multiple values for that name. In list context you will receive I of the values for that name. Note that this method will normalize the parameters. =head2 params my $array = $params->params; $params = $params->params([foo => 'b;ar', baz => 23]); Parsed parameters. 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; my $str = "$params"; Turn parameters into a string. =head1 PARAMETERS Direct array reference access to the parsed parameters is also possible. Note that this will normalize the parameters. say $params->[0]; say for @$params; =head1 SEE ALSO L, L, L. =cut