use base 'Class::Accessor::Fast';
use CGI::Simple::Cookie;
use Data::Dump qw/dump/;
+use Errno 'EWOULDBLOCK';
use HTML::Entities;
use HTTP::Body;
use HTTP::Headers;
-use URI::Escape ();
use URI::QueryParam;
use Scalar::Util ();
# Amount of data to read from input on each pass
our $CHUNKSIZE = 64 * 1024;
-# See if we can use libapreq2 for URI unescaping
-use constant HAS_APR => eval {
- require APR::Request;
-};
-
=head1 NAME
Catalyst::Engine - The Catalyst Engine
=cut
-sub finalize_read {
- my ( $self, $c ) = @_;
-
- undef $self->{_prepared_read};
-}
+sub finalize_read { }
=head2 $self->finalize_uploads($c)
sub prepare_body {
my ( $self, $c ) = @_;
-
- my $length = $c->request->header('Content-Length') || 0;
-
- $self->read_length( $length );
- if ( $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 );
my ( $self, $c, $query_string ) = @_;
# Check for keywords (no = signs)
+ # (yes, index() is faster than a regex :))
if ( index( $query_string, '=' ) < 0 ) {
- $c->request->keywords( $self->unescape_uri($query_string) );
+ $c->request->query_keywords( $self->unescape_uri($query_string) );
return;
}
my ($param, $value)
= map { $self->unescape_uri($_) }
- split( /=/, $item );
+ split( /=/, $item, 2 );
$param = $self->unescape_uri($item) unless defined $param;
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)
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;
=head2 $self->write($c, $buffer)
-Writes the buffer to the client. Can only be called once for a request.
+Writes the buffer to the client.
=cut
$self->prepare_write($c);
$self->{_prepared_write} = 1;
}
-
- print STDOUT $buffer;
+
+ my $len = length($buffer);
+ my $wrote = syswrite STDOUT, $buffer;
+
+ if ( !defined $wrote && $! == EWOULDBLOCK ) {
+ # Unable to write on the first try, will retry in the loop below
+ $wrote = 0;
+ }
+
+ if ( defined $wrote && $wrote < $len ) {
+ # We didn't write the whole buffer
+ while (1) {
+ my $ret = syswrite STDOUT, $buffer, $CHUNKSIZE, $wrote;
+ if ( defined $ret ) {
+ $wrote += $ret;
+ }
+ else {
+ next if $! == EWOULDBLOCK;
+ return;
+ }
+
+ last if $wrote >= $len;
+ }
+ }
+
+ return $wrote;
}
=head2 $self->unescape_uri($uri)
-Unescapes a given URI using the most efficient method available. Engines
-can subclass to provide faster implementations.
+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;
-
- if ( HAS_APR ) {
- return APR::Request::decode(@_);
- }
-
- my $e = URI::Escape::uri_unescape(@_);
- $e =~ s/\+/ /g;
-
- return $e;
+ my ( $self, $str ) = @_;
+
+ $str =~ s/(?:%([0-9A-Fa-f]{2})|\+)/defined $1 ? chr(hex($1)) : ' '/eg;
+
+ return $str;
}
=head2 $self->finalize_output