File Coverage

blib/lib/Mojo/Parameters.pm

Criterion	Covered	Total	%
statement	107	107	100.0
branch	51	52	98.0
condition	11	14	78.5
subroutine	18	18	100.0
pod	12	12	100.0
total	199	203	98.0

package Mojo::Parameters;
use Mojo::Base -base;
use overload '@{}' => 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 $merge = @_ == 1 ? shift->to_hash : {@_};
  for my $name (sort keys %$merge) {
    my $value = $merge->{$name};
    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 is a container for form parameters used by L, based on L
3986|https://tools.ietf.org/html/rfc3986> and the 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 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 object cloned from these parameters.

=head2 every_param

  my $values = $params->every_param('foo');

Similar to L, 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 object and L 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. 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 overloads the following operators.

=head2 array

  my @pairs = @$params;

Alias for L. 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.

=head1 SEE ALSO

L, L, L.

=cut