Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
fixed small bug in Mojo::Parameters->params
  • Loading branch information
kraih committed Apr 4, 2012
1 parent df0101a commit 04d7d53
Show file tree
Hide file tree
Showing 12 changed files with 207 additions and 226 deletions.
1 change: 1 addition & 0 deletions Changes
Expand Up @@ -2,6 +2,7 @@ This file documents the revision history for Perl extension Mojolicious.

2.75 2012-04-05
- Improved documentation.
- Fixed small bug in Mojo::Parameters->params.

2.74 2012-04-04
- Improved documentation.
Expand Down
21 changes: 11 additions & 10 deletions lib/Mojo/CookieJar.pm
Expand Up @@ -16,8 +16,10 @@ sub add {

# Add cookies
for my $cookie (@cookies) {
my ($name, $value, $domain, $path) =
($cookie->name, $cookie->value, $cookie->domain, $cookie->path);
my $name = $cookie->name;
my $value = $cookie->value;
my $domain = $cookie->domain;
my $path = $cookie->path;

# Convert max age to expires
$cookie->expires($cookie->max_age + time) if $cookie->max_age;
Expand All @@ -30,10 +32,8 @@ sub add {

# Replace cookie
$domain =~ s/^\.//;
my @new =
grep { $_->path ne $path || $_->name ne $name }
@{$self->{jar}->{$domain} || []};
$self->{jar}->{$domain} = [@new, $cookie];
my $jar = $self->{jar}->{$domain} ||= [];
@$jar = (grep({$_->path ne $path || $_->name ne $name} @$jar), $cookie);
}

return $self;
Expand Down Expand Up @@ -70,19 +70,20 @@ sub find {
for my $cookie (@$jar) {

# Check if cookie has expired
my $session = defined $cookie->max_age && $cookie->max_age > 0 ? 1 : 0;
my $expires = $cookie->expires;
my $session = defined $cookie->max_age && $cookie->max_age > 0 ? 1 : 0;
next if $expires && !$session && time > ($expires->epoch || 0);
push @new, $cookie;

# Taste cookie
next if $cookie->secure && $url->scheme ne 'https';
my $cpath = $cookie->path;
push @found,
Mojo::Cookie::Request->new(
next unless $path =~ /^\Q$cpath/;
my $result = Mojo::Cookie::Request->new(
name => $cookie->name,
value => $cookie->value
) if $path =~ /^\Q$cpath/;
);
push @found, $result;
}

$self->{jar}->{$domain} = \@new;
Expand Down
12 changes: 6 additions & 6 deletions lib/Mojo/Message.pm
Expand Up @@ -67,13 +67,13 @@ sub body_params {
return $self->{body_params} if $self->{body_params};

# Charset
my $params = Mojo::Parameters->new;
$params->charset($self->content->charset || $self->default_charset);
my $p = Mojo::Parameters->new;
$p->charset($self->content->charset || $self->default_charset);

# "x-application-urlencoded" and "application/x-www-form-urlencoded"
my $type = $self->headers->content_type || '';
if ($type =~ m#(?:x-application|application/x-www-form)-urlencoded#i) {
$params->parse($self->content->asset->slurp);
$p->parse($self->content->asset->slurp);
}

# "multipart/formdata"
Expand All @@ -88,11 +88,11 @@ sub body_params {
next if defined $filename;

# Form value
$params->append($name, $value);
$p->append($name, $value);
}
}

return $self->{body_params} = $params;
return $self->{body_params} = $p;
}

sub body_size { shift->content->body_size }
Expand Down Expand Up @@ -590,7 +590,7 @@ Access C<content> data or replace all subscribers of the C<read> event.
=head2 C<body_params>
my $params = $message->body_params;
my $p = $message->body_params;
C<POST> parameters extracted from C<x-application-urlencoded>,
C<application/x-www-form-urlencoded> or C<multipart/form-data> message body,
Expand Down
10 changes: 5 additions & 5 deletions lib/Mojo/Message/Request.pm
Expand Up @@ -98,9 +98,9 @@ sub param {
}

sub params {
my $self = shift;
my $params = Mojo::Parameters->new;
return $params->merge($self->body_params, $self->query_params);
my $self = shift;
my $p = Mojo::Parameters->new;
return $p->merge($self->body_params, $self->query_params);
}

sub parse {
Expand Down Expand Up @@ -427,7 +427,7 @@ Access C<GET> and C<POST> parameters.
=head2 C<params>
my $params = $req->params;
my $p = $req->params;
All C<GET> and C<POST> parameters, usually a L<Mojo::Parameters> object.
Expand All @@ -451,7 +451,7 @@ Proxy URL for message.
=head2 C<query_params>
my $params = $req->query_params;
my $p = $req->query_params;
All C<GET> parameters, usually a L<Mojo::Parameters> object.
Expand Down
49 changes: 24 additions & 25 deletions lib/Mojo/Parameters.pm
Expand Up @@ -79,7 +79,7 @@ sub param {

sub params {
my ($self, $params) = @_;
if ($params) { $self->{params} = $params }
if ($params) { $self->{params} = $params and return $self }
elsif (defined $self->{string}) { $self->parse }
return $self->{params} ||= [];
}
Expand Down Expand Up @@ -137,9 +137,8 @@ sub remove {
if ($params->[$i] eq $name) { splice @$params, $i, 2 }
else { $i += 2 }
}
$self->params($params);

return $self;
return $self->params($params);
}

sub to_hash {
Expand Down Expand Up @@ -215,7 +214,7 @@ Mojo::Parameters - Parameter container
use Mojo::Parameters;
my $params = Mojo::Parameters->new(foo => 'bar', baz => 23);
my $p = Mojo::Parameters->new(foo => 'bar', baz => 23);
=head1 DESCRIPTION
Expand All @@ -227,15 +226,15 @@ L<Mojo::Parameters> implements the following attributes.
=head2 C<charset>
my $charset = $params->charset;
$params = $params->charset('UTF-8');
my $charset = $p->charset;
$p = $p->charset('UTF-8');
Charset used for decoding parameters, defaults to C<UTF-8>.
=head2 C<pair_separator>
my $separator = $params->pair_separator;
$params = $params->pair_separator(';');
my $separator = $p->pair_separator;
$p = $p->pair_separator(';');
Separator for parameter pairs, defaults to C<&>.
Expand All @@ -246,15 +245,15 @@ the following new ones.
=head2 C<new>
my $params = Mojo::Parameters->new;
my $params = Mojo::Parameters->new('foo=b%3Bar&baz=23');
my $params = Mojo::Parameters->new(foo => 'b;ar', baz => 23);
my $p = Mojo::Parameters->new;
my $p = Mojo::Parameters->new('foo=b%3Bar&baz=23');
my $p = Mojo::Parameters->new(foo => 'b;ar', baz => 23);
Construct a new L<Mojo::Parameters> object.
=head2 C<append>
$params = $params->append(foo => 'ba;r');
$p = $p->append(foo => 'ba;r');
Append parameters.
Expand All @@ -263,42 +262,42 @@ Append parameters.
=head2 C<clone>
my $params2 = $params->clone;
my $p2 = $p->clone;
Clone parameters.
=head2 C<merge>
$params = $params->merge($params2, $params3);
$p = $p->merge($p2, $p3);
Merge parameters.
=head2 C<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/);
my @names = $p->param;
my $foo = $p->param('foo');
my @foo = $p->param('foo');
my $foo = $p->param(foo => 'ba;r');
my @foo = $p->param(foo => qw/ba;r ba;z/);
Check and replace parameter values.
=head2 C<params>
my $parameters = $params->params;
$params = $params->params([foo => 'b;ar', baz => 23]);
my $params = $p->params;
$p = $p->params([foo => 'b;ar', baz => 23]);
Parsed parameters.
=head2 C<parse>
$params = $params->parse('foo=b%3Bar&baz=23');
$p = $p->parse('foo=b%3Bar&baz=23');
Parse parameters.
=head2 C<remove>
$params = $params->remove('foo');
$p = $p->remove('foo');
Remove parameters.
Expand All @@ -307,7 +306,7 @@ Remove parameters.
=head2 C<to_hash>
my $hash = $params->to_hash;
my $hash = $p->to_hash;
Turn parameters into a hash reference.
Expand All @@ -316,7 +315,7 @@ Turn parameters into a hash reference.
=head2 C<to_string>
my $string = $params->to_string;
my $string = $p->to_string;
Turn parameters into a string.
Expand Down
15 changes: 6 additions & 9 deletions lib/Mojo/Path.pm
Expand Up @@ -34,9 +34,8 @@ sub canonicalize {
push @parts, $part;
}
$self->trailing_slash(undef) unless @parts;
$self->parts(\@parts);

return $self;
return $self->parts(\@parts);
}

# "Homer, the plant called.
Expand All @@ -47,7 +46,8 @@ sub clone {
my $clone = Mojo::Path->new;
$clone->parts([@{$self->parts}]);
$clone->leading_slash($self->leading_slash);
return $clone->trailing_slash($self->trailing_slash);
$clone->trailing_slash($self->trailing_slash);
return $clone;
}

sub contains {
Expand All @@ -70,9 +70,8 @@ sub parse {
utf8::decode $path;
$path =~ s|^/|| ? $self->leading_slash(1) : $self->leading_slash(undef);
$path =~ s|/$|| ? $self->trailing_slash(1) : $self->trailing_slash(undef);
$self->parts([split '/', $path, -1]);

return $self;
return $self->parts([split '/', $path, -1]);
}

sub to_abs_string {
Expand All @@ -89,10 +88,8 @@ sub to_string {
my $self = shift;

# Escape
my @parts = map {
url_escape(encode('UTF-8', $_),
"$Mojo::URL::UNRESERVED$Mojo::URL::SUBDELIM\:\@")
} @{$self->parts};
my $chars = "$Mojo::URL::UNRESERVED$Mojo::URL::SUBDELIM\:\@";
my @parts = map { url_escape(encode('UTF-8', $_), $chars) } @{$self->parts};

# Format
my $path = join '/', @parts;
Expand Down
54 changes: 19 additions & 35 deletions lib/Mojo/URL.pm
Expand Up @@ -72,34 +72,21 @@ sub clone {
}

sub ihost {
my ($self, $host) = @_;

# Generate host
if (defined $host) {

# Decode parts
my @decoded;
for my $part (split /\./, $_[1]) {
$part = punycode_decode $1 if $part =~ /^xn--(.+)$/;
push @decoded, $part;
}
$self->host(join '.', @decoded);
my $self = shift;

return $self;
}
# Decode
return $self->host(join '.',
map { /^xn--(.+)$/ ? punycode_decode($_) : $_ } split /\./, shift)
if @_;

# Host
return unless $host = $self->host;
# Check if host needs to be encoded
return unless my $host = $self->host;
return $host unless $host =~ /[^\x00-\x7f]/;

# Encode parts
my @encoded;
for my $part (split /\./, $host || '') {
$part = 'xn--' . punycode_encode $part if $part =~ /[^\x00-\x7f]/;
push @encoded, $part;
}

return join '.', @encoded;
# Encode
return join '.',
map { /[^\x00-\x7f]/ ? ('xn--' . punycode_encode $_) : $_ } split /\./,
$host;
}

sub is_abs { shift->scheme }
Expand All @@ -109,13 +96,12 @@ sub parse {
return $self unless $url;

# Official regex
my ($scheme, $authority, $path, $query, $fragment) = $url
=~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
$self->scheme($scheme);
$self->authority($authority);
$self->path->parse($path);
$self->query($query);
$self->fragment($fragment);
$url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
$self->scheme($1);
$self->authority($2);
$self->path->parse($3);
$self->query($4);
$self->fragment($5);

return $self;
}
Expand Down Expand Up @@ -150,13 +136,11 @@ sub path {
sub query {
my $self = shift;

# Get parameters
# Old parameters
return $self->{query} ||= Mojo::Parameters->new unless @_;

# Replace with list
if (@_ > 1) {
$self->{query} = Mojo::Parameters->new(ref $_[0] ? @{$_[0]} : @_);
}
if (@_ > 1) { $self->{query} = Mojo::Parameters->new(@_) }

# Merge with array
elsif ((ref $_[0] || '') eq 'ARRAY') {
Expand Down

0 comments on commit 04d7d53

Please sign in to comment.