X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=ba30a6785dac9cba95d0c8ea86a7d6935b70fc12;hb=51674a636e6cb030f3a45b24dbcf81ae9ebfc0bb;hp=ab4c3f0c0dd524a64c4be078a62768e68254671b;hpb=72f87c4bec018bc59ef69db7c55b9a8d68bb503d;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index ab4c3f0..ba30a67 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -24,7 +24,7 @@ use Tree::Simple qw/use_weak_refs/; use Tree::Simple::Visitor::FindByUID; use attributes; use utf8; -use Carp qw/croak/; +use Carp qw/croak carp/; BEGIN { require 5.008001; } @@ -61,7 +61,7 @@ __PACKAGE__->response_class('Catalyst::Response'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.7007'; +our $VERSION = '5.7008'; sub import { my ( $class, @arguments ) = @_; @@ -914,11 +914,6 @@ to C. sub uri_for { my ( $c, $path, @args ) = @_; - my $base = $c->request->base->clone; - my $basepath = $base->path; - $basepath =~ s/\/$//; - $basepath .= '/'; - my $namespace = $c->namespace || ''; if ( Scalar::Util::blessed($path) ) { # action object my $captures = ( scalar @args && ref $args[0] eq 'ARRAY' @@ -929,32 +924,52 @@ sub uri_for { $path = '/' if $path eq ''; } - # massage namespace, empty if absolute path - $namespace =~ s/^\/// if $namespace; - $namespace .= '/' if $namespace; - $path ||= ''; - $namespace = '' if $path =~ /^\//; - $path =~ s/^\///; - $path =~ s/\?/%3F/g; + undef($path) if (defined $path && $path eq ''); my $params = ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); - for my $value ( values %$params ) { - next unless defined $value; - for ( ref $value eq 'ARRAY' ? @$value : $value ) { - $_ = "$_"; - utf8::encode( $_ ); + s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args; + + unshift(@args, $path); + + unless (defined $path && $path =~ s!^/!!) { # in-place strip + my $namespace = $c->namespace; + if (defined $path) { # cheesy hack to handle path '../foo' + $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{}; } - }; + unshift(@args, $namespace || ''); + } # join args with '/', or a blank string - my $args = ( scalar @args ? '/' . join( '/', map {s/\?/%3F/g; $_} @args ) : '' ); - $args =~ s/^\/// unless $path; - my $res = - URI->new_abs( URI->new_abs( "$path$args", "$basepath$namespace" ), $base ) - ->canonical; - $res->query_form(%$params); + my $args = join('/', grep { defined($_) } @args); + $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE + $args =~ s!^/!!; + my $base = $c->req->base; + my $class = ref($base); + $base =~ s{(?{$_}; + $val = '' unless defined $val; + (map { + $_ = "$_"; + utf8::encode( $_ ); + # using the URI::Escape pattern here so utf8 chars survive + s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; + s/ /+/g; + "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val )); + } @keys); + } + + my $res = bless(\"${base}${args}${query}", $class); $res; } @@ -1399,7 +1414,7 @@ sub finalize_headers { if ( !$c->response->body ) { # Add a default body if none is already present $c->response->body( - "

This item has moved here.

" + qq{

This item has moved here.

} ); } }