X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine.pm;h=564cb42447dd573abc234c6e8ac70911efb6305b;hb=6a44fe01d6d82796cfd1b514676efc9fc2cf7de6;hp=f0758907cf9fd87f47bdb99344585e97e5815d82;hpb=4e939e53ffc8aee7c2fb179a65b7dfe08dda7f86;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index f075890..564cb42 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -7,6 +7,7 @@ use Data::Dump qw/dump/; use HTML::Entities; use HTTP::Body; use HTTP::Headers; +use URI::Escape (); use URI::QueryParam; use Scalar::Util (); @@ -17,7 +18,7 @@ __PACKAGE__->mk_accessors(qw/read_position read_length/); use overload '""' => sub { return ref shift }, fallback => 1; # Amount of data to read from input on each pass -our $CHUNKSIZE = 4096; +our $CHUNKSIZE = 64 * 1024; =head1 NAME @@ -312,29 +313,35 @@ sets up the L object body using L sub prepare_body { my ( $self, $c ) = @_; + + my $length = $c->request->header('Content-Length') || 0; - $self->read_length( $c->request->header('Content-Length') || 0 ); - my $type = $c->request->header('Content-Type'); - - unless ( $c->request->{_body} ) { - $c->request->{_body} = HTTP::Body->new( $type, $self->read_length ); - $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp} - if exists $c->config->{uploadtmp}; - } + $self->read_length( $length ); - if ( $self->read_length > 0 ) { + if ( $length > 0 ) { + unless ( $c->request->{_body} ) { + my $type = $c->request->header('Content-Type'); + $c->request->{_body} = HTTP::Body->new( $type, $length ); + $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp} + if exists $c->config->{uploadtmp}; + } + while ( my $buffer = $self->read($c) ) { $c->prepare_body_chunk($buffer); } # paranoia against wrong Content-Length header - my $remaining = $self->read_length - $self->read_position; + my $remaining = $length - $self->read_position; if ( $remaining > 0 ) { $self->finalize_read($c); Catalyst::Exception->throw( - "Wrong Content-Length value: " . $self->read_length ); + "Wrong Content-Length value: $length" ); } } + else { + # Defined but will cause all body code to be skipped + $c->request->{_body} = 0; + } } =head2 $self->prepare_body_chunk($c) @@ -357,6 +364,9 @@ Sets up parameters from body. sub prepare_body_parameters { my ( $self, $c ) = @_; + + return unless $c->request->{_body}; + $c->request->body_parameters( $c->request->{_body}->param ); } @@ -437,16 +447,42 @@ process the query string and extract query parameters. sub prepare_query_parameters { my ( $self, $c, $query_string ) = @_; + + # Check for keywords (no = signs) + if ( index( $query_string, '=' ) < 0 ) { + $c->request->keywords( $self->unescape_uri($query_string) ); + return; + } + + my %query; # replace semi-colons $query_string =~ s/;/&/g; - - my $u = URI->new( '', 'http' ); - $u->query($query_string); - for my $key ( $u->query_param ) { - my @vals = $u->query_param($key); - $c->request->query_parameters->{$key} = @vals > 1 ? [@vals] : $vals[0]; + + my @params = split /&/, $query_string; + + for my $item ( @params ) { + + my ($param, $value) + = map { $self->unescape_uri($_) } + split( /=/, $item ); + + $param = $self->unescape_uri($item) unless defined $param; + + if ( exists $query{$param} ) { + if ( ref $query{$param} ) { + push @{ $query{$param} }, $value; + } + else { + $query{$param} = [ $query{$param}, $value ]; + } + } + else { + $query{$param} = $value; + } } + + $c->request->query_parameters( \%query ); } =head2 $self->prepare_read($c) @@ -476,6 +512,9 @@ sub prepare_request { } sub prepare_uploads { my ( $self, $c ) = @_; + + return unless $c->request->{_body}; + my $uploads = $c->request->{_body}->upload; for my $name ( keys %$uploads ) { my $files = $uploads->{$name}; @@ -494,8 +533,20 @@ sub prepare_uploads { # support access to the filename as a normal param my @filenames = map { $_->{filename} } @uploads; - $c->request->parameters->{$name} = - @filenames > 1 ? \@filenames : $filenames[0]; + # append, if there's already params with this name + if (exists $c->request->parameters->{$name}) { + if (ref $c->request->parameters->{$name} eq 'ARRAY') { + push @{ $c->request->parameters->{$name} }, @filenames; + } + else { + $c->request->parameters->{$name} = + [ $c->request->parameters->{$name}, @filenames ]; + } + } + else { + $c->request->parameters->{$name} = + @filenames > 1 ? \@filenames : $filenames[0]; + } } } @@ -579,12 +630,25 @@ sub write { $self->prepare_write($c); $self->{_prepared_write} = 1; } - - return unless *STDOUT->opened(); print STDOUT $buffer; } +=head2 $self->unescape_uri($uri) + +Unescapes a given URI using the most efficient method available. Engines such +as Apache may implement this using Apache's C-based modules, for example. + +=cut + +sub unescape_uri { + my $self = shift; + + my $e = URI::Escape::uri_unescape(@_); + $e =~ s/\+/ /g; + + return $e; +} =head2 $self->finalize_output