X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FCGI.pm;h=2ee2e01ecbb46338b601ca5d0a66bb55c5890e56;hb=0bf2648c4dcbd7fc6b97b67701ba1425478a6ef9;hp=103ed35ccceaf34ef8e9602734c2e8b7f6729244;hpb=4bb8bd62f620afd41160a61a2995d319779a3d99;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine/CGI.pm b/lib/Catalyst/Engine/CGI.pm index 103ed35..2ee2e01 100644 --- a/lib/Catalyst/Engine/CGI.pm +++ b/lib/Catalyst/Engine/CGI.pm @@ -3,9 +3,7 @@ package Catalyst::Engine::CGI; use strict; use base 'Catalyst::Engine'; use NEXT; -use URI; -my $uri_proto=URI->new(); __PACKAGE__->mk_accessors('env'); =head1 NAME @@ -137,26 +135,36 @@ sub prepare_path { $port = $c->request->secure ? 443 : 80; } + # set the request URI my $path = $base_path . ( $ENV{PATH_INFO} || '' ); $path =~ s{^/+}{}; + + # Using URI directly is way too slow, so we construct the URLs manually + my $uri_class = "URI::$scheme"; + + # HTTP_HOST will include the port even if it's 80 + $host =~ s/:80$//; + + if ( $port != 80 && $host !~ /:/ ) { + $host .= ":$port"; + } + + # Escape the path + $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE + + my $query = $ENV{QUERY_STRING} ? '?' . $ENV{QUERY_STRING} : ''; + my $uri = $scheme . '://' . $host . '/' . $path . $query; - my $uri = $uri_proto->clone; - $uri->scheme($scheme); - $uri->host($host); - $uri->port($port); - $uri->path($path); - $uri->query( $ENV{QUERY_STRING} ) if $ENV{QUERY_STRING}; - - # sanitize the URI - $uri = $uri->canonical; - $c->request->uri($uri); + $c->request->uri( bless \$uri, $uri_class ); # set the base URI # base must end in a slash - $base_path .= '/' unless ( $base_path =~ /\/$/ ); - my $base = $uri->clone; - $base->path_query($base_path); - $c->request->base($base); + $base_path .= '/' unless $base_path =~ m{/$}; + + my $base_uri = $scheme . '://' . $host . $base_path; + + $c->request->base( bless \$base_uri, $uri_class ); } =head2 $self->prepare_query_parameters($c)