Tis file documents the revision history for Perl extension Catalyst.
5.50
+ - Removed req->handle and res->handle
- Added prepare_body_chunk method as a hook for upload progress.
- Fixed bug in uri_for method when base has no path.
arguments => [],
body_parameters => {},
cookies => {},
- handle => \*STDIN,
headers => HTTP::Headers->new,
parameters => {},
query_parameters => {},
{
body => '',
cookies => {},
- handle => \*STDOUT,
headers => HTTP::Headers->new(),
status => 200
}
=cut
-sub prepare_body_chunk {
- my $c = shift;
+sub prepare_body_chunk {
+ my $c = shift;
$c->engine->prepare_body_chunk( $c, @_ );
}
=cut
-sub write { my $c = shift; return $c->engine->write( $c, @_ ) }
+sub write {
+ my $c = shift;
+
+ # Finalize headers if someone manually writes output
+ $c->finalize_headers;
+
+ return $c->engine->write( $c, @_ );
+}
=back
use HTTP::Headers;
# input position and length
-__PACKAGE__->mk_accessors( qw/read_position read_length/ );
+__PACKAGE__->mk_accessors(qw/read_position read_length/);
# Stringify to class
use overload '""' => sub { return ref shift }, fallback => 1;
sub finalize_body {
my ( $self, $c ) = @_;
-
+
$self->write( $c, $c->response->output );
}
sub finalize_read {
my ( $self, $c ) = @_;
-
+
undef $self->{_prepared_read};
}
unless ( $c->request->{_body} ) {
$c->request->{_body} = HTTP::Body->new( $type, $self->read_length );
}
-
+
if ( $self->read_length > 0 ) {
- while ( my $buffer = $self->read( $c ) ) {
- $c->prepare_body_chunk( $buffer );
+ while ( my $buffer = $self->read($c) ) {
+ $c->prepare_body_chunk($buffer);
}
}
}
sub prepare_body_chunk {
my ( $self, $c, $chunk ) = @_;
-
- $c->request->{_body}->add( $chunk );
+
+ $c->request->{_body}->add($chunk);
}
=item $self->prepare_body_parameters($c)
sub prepare_read {
my ( $self, $c ) = @_;
-
+
# Reset the read position
- $self->read_position( 0 );
+ $self->read_position(0);
}
=item $self->prepare_request(@arguments)
sub read {
my ( $self, $c, $maxlength ) = @_;
-
+
unless ( $self->{_prepared_read} ) {
- $self->prepare_read( $c );
+ $self->prepare_read($c);
$self->{_prepared_read} = 1;
}
-
+
my $remaining = $self->read_length - $self->read_position;
$maxlength ||= $CHUNKSIZE;
-
+
# Are we done reading?
if ( $remaining <= 0 ) {
- $self->finalize_read( $c );
+ $self->finalize_read($c);
return;
}
return $buffer;
}
else {
- Catalyst::Exception->throw(
- message => "Unknown error reading input: $!"
- );
+ Catalyst::Exception->throw(
+ message => "Unknown error reading input: $!" );
}
}
sub write {
my ( $self, $c, $buffer ) = @_;
-
+
unless ( $self->{_prepared_write} ) {
- $self->prepare_write( $c );
+ $self->prepare_write($c);
$self->{_prepared_write} = 1;
}
-
- my $handle = $c->response->handle;
-
- print $handle $buffer;
+
+ print STDOUT $buffer;
}
=back
sub prepare_connection {
my ( $self, $c ) = @_;
-
+
$c->request->address( $ENV{REMOTE_ADDR} );
-
- PROXY_CHECK:
+
+ PROXY_CHECK:
{
unless ( $c->config->{using_frontend_proxy} ) {
last PROXY_CHECK if $ENV{REMOTE_ADDR} ne '127.0.0.1';
last PROXY_CHECK if $c->config->{ignore_frontend_proxy};
}
last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_FOR};
-
+
# If we are running as a backend server, the user will always appear
# as 127.0.0.1. Select the most recent upstream IP (last in the list)
my ($ip) = $ENV{HTTP_X_FORWARDED_FOR} =~ /([^,\s]+)$/;
- $c->request->address( $ip );
+ $c->request->address($ip);
}
$c->request->hostname( $ENV{REMOTE_HOST} );
sub prepare_path {
my ( $self, $c ) = @_;
- my $scheme = $c->request->secure ? 'https' : 'http';
+ my $scheme = $c->request->secure ? 'https' : 'http';
my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
my $port = $ENV{SERVER_PORT} || 80;
my $base_path = $ENV{SCRIPT_NAME} || '/';
-
+
# If we are running as a backend proxy, get the true hostname
- PROXY_CHECK:
+ PROXY_CHECK:
{
unless ( $c->config->{using_frontend_proxy} ) {
last PROXY_CHECK if $host !~ /localhost|127.0.0.1/;
last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_HOST};
$host = $ENV{HTTP_X_FORWARDED_HOST};
- # backend could be on any port, so
+
+ # backend could be on any port, so
# assume frontend is on the default port
$port = $c->request->secure ? 443 : 80;
}
my $path = $base_path . $ENV{PATH_INFO};
$path =~ s{^/+}{};
-
+
my $uri = URI->new;
- $uri->scheme( $scheme );
- $uri->host( $host );
- $uri->port( $port );
- $uri->path( $path );
+ $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($uri);
# set the base URI
# base must end in a slash
- $base_path .= '/' unless ( $base_path =~ /\/$/ );
+ $base_path .= '/' unless ( $base_path =~ /\/$/ );
my $base = $uri->clone;
- $base->path_query( $base_path );
- $c->request->base( $base );
+ $base->path_query($base_path);
+ $c->request->base($base);
}
=item $self->prepare_query_parameters($c)
sub prepare_query_parameters {
my ( $self, $c ) = @_;
-
+
my $u = URI::Query->new( $ENV{QUERY_STRING} );
$c->request->query_parameters( { $u->hash } );
}
sub prepare_write {
my ( $self, $c ) = @_;
-
+
# Set the output handle to autoflush
- $c->response->handle->autoflush(1);
-
- $self->NEXT::prepare_write( $c );
+ *STDOUT->autoflush(1);
+
+ $self->NEXT::prepare_write($c);
}
=item $self->read_chunk($c, $buffer, $length)
=cut
-sub read_chunk { shift; shift->request->handle->sysread( @_ ); }
+sub read_chunk { shift; shift; *STDIN->sysread(@_); }
=item $self->run
sub write {
my ( $self, $c, $buffer ) = @_;
-
+
unless ( $self->{_prepared_write} ) {
- $self->prepare_write( $c );
+ $self->prepare_write($c);
$self->{_prepared_write} = 1;
}
-
+
# FastCGI does not stream data properly if using 'print $handle',
# but a syswrite appears to work properly.
- $c->response->handle->syswrite( $buffer );
+ *STDOUT->syswrite($buffer);
}
=back
# Never ever remove this, it would result in random length output
# streams if STDIN eq STDOUT (like in the HTTP engine)
- $c->request->handle->blocking(1);
+ *STDIN->blocking(1);
return $self->NEXT::finalize_read($c);
}
my ( $self, $c ) = @_;
# Set the input handle to non-blocking
- $c->request->handle->blocking(0);
+ *STDIN->blocking(0);
return $self->NEXT::prepare_read($c);
}
my $c = shift;
# support for non-blocking IO
- my $handle = $c->request->handle;
- my $rin = '';
- vec( $rin, $handle->fileno, 1 ) = 1;
+ my $rin = '';
+ vec( $rin, *STDIN->fileno, 1 ) = 1;
READ:
{
select( $rin, undef, undef, undef );
- my $rc = $handle->sysread(@_);
+ my $rc = *STDIN->sysread(@_);
if ( defined $rc ) {
return $rc;
}
# Ignore broken pipes as an HTTP server should
local $SIG{PIPE} = sub { close Remote };
- local $SIG{HUP} = (defined $pid ? 'IGNORE' : $SIG{HUP});
+ local $SIG{HUP} = ( defined $pid ? 'IGNORE' : $SIG{HUP} );
local *STDIN = \*Remote;
local *STDOUT = \*Remote;
# We emulate CGI
local %ENV = (
- PATH_INFO => $request->uri->path || '',
- QUERY_STRING => $request->uri->query || '',
- REMOTE_ADDR => '127.0.0.1',
- REMOTE_HOST => 'localhost',
+ PATH_INFO => $request->uri->path || '',
+ QUERY_STRING => $request->uri->query || '',
+ REMOTE_ADDR => '127.0.0.1',
+ REMOTE_HOST => 'localhost',
REQUEST_METHOD => $request->method,
SERVER_NAME => 'localhost',
SERVER_PORT => $request->uri->port,
$name = 'COOKIE' if $name eq 'COOKIES';
$name =~ tr/-/_/;
$name = 'HTTP_' . $name
- unless $name =~ m/\A(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)\z/;
+ unless $name =~ m/\A(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)\z/;
my $value = $request->header($header);
if ( exists $ENV{$name} ) {
$ENV{$name} .= "; $value";
=cut
-sub read_chunk { shift; shift->request->handle->read( @_ ); }
+sub read_chunk { shift; shift; *STDIN->read(@_); }
=back
use IO::Socket qw[AF_INET inet_aton];
__PACKAGE__->mk_accessors(
- qw/action address arguments base cookies handle headers match method
+ qw/action address arguments base cookies headers match method
protocol query_parameters secure snippets uri user/
);
$req->content_type;
$req->cookie;
$req->cookies;
- $req->handle;
$req->header;
$req->headers;
$req->hostname;
print $c->request->cookies->{mycookie}->value;
-=item $req->handle
-
-Request IO handle.
-
=item $req->header
Shortcut to $req->headers->header
sub path {
my ( $self, $params ) = @_;
-
- if ( $params ) {
+
+ if ($params) {
+
# base must always have a trailing slash
$params .= '/' unless ( $params =~ /\/$/ );
- $self->uri->path( $params );
+ $self->uri->path($params);
}
- my $path = $self->uri->path;
+ my $path = $self->uri->path;
my $location = $self->base->path;
$path =~ s/^(\Q$location\E)?//;
$path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
$path =~ s/^\///;
-
+
return $path;
}
$res->content_length;
$res->content_type;
$res->cookies;
- $res->handle;
$res->header;
$res->headers;
$res->output;
$c->response->cookies->{foo} = { value => '123' };
-=item $res->handle
-
-Response IO handle.
-
-=cut
-
-sub handle {
- my ( $self, $handle ) = @_;
-
- if ($handle) {
- $self->{handle} = $handle;
- }
- else {
- # Finalize headers if someone touches the output handle
- if ( $self->{_context} ) {
- $self->{_context}->finalize_headers;
- }
- }
-
- return $self->{handle};
-}
-
=item $res->header
Shortcut to $res->headers->header
projects / catagits/Catalyst-Runtime.git / commitdiff