X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine.pm;h=0f801aa711f85439c3921148b69ec5719ef77b6d;hb=bba13f350e550b180357d24e478ab120642d1d71;hp=3a73c04fa2a7b8df2308410139be1c67ccba188f;hpb=f9b6d6122c224d2a46e1bcc4f0c98b16d0db21ce;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index 3a73c04..0f801aa 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -17,7 +17,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 @@ -279,11 +279,7 @@ sub finalize_headers { } =cut -sub finalize_read { - my ( $self, $c ) = @_; - - undef $self->{_prepared_read}; -} +sub finalize_read { } =head2 $self->finalize_uploads($c) @@ -313,28 +309,30 @@ sets up the L object body using L sub prepare_body { my ( $self, $c ) = @_; - $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}; - } - - if ( $self->read_length > 0 ) { + if ( my $length = $self->read_length ) { + 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 +355,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 +438,43 @@ process the query string and extract query parameters. sub prepare_query_parameters { my ( $self, $c, $query_string ) = @_; + + # Check for keywords (no = signs) + # (yes, index() is faster than a regex :)) + if ( index( $query_string, '=' ) < 0 ) { + $c->request->query_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) @@ -458,8 +486,11 @@ prepare to read from the engine. sub prepare_read { my ( $self, $c ) = @_; - # Reset the read position + # Initialize the read position $self->read_position(0); + + # Initialize the amount of data we think we need to read + $self->read_length( $c->request->header('Content-Length') || 0 ); } =head2 $self->prepare_request(@arguments) @@ -476,6 +507,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 +528,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]; + } } } @@ -514,11 +560,6 @@ sub prepare_write { } sub read { my ( $self, $c, $maxlength ) = @_; - unless ( $self->{_prepared_read} ) { - $self->prepare_read($c); - $self->{_prepared_read} = 1; - } - my $remaining = $self->read_length - $self->read_position; $maxlength ||= $CHUNKSIZE; @@ -583,6 +624,21 @@ sub write { 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, $str ) = @_; + + $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + $str =~ s/\+/ /g; + + return $str; +} =head2 $self->finalize_output