[Bps-public-commit] HTTP-Server-Simple-Mason branch, master, updated. ca9b215dfc1eb40b00d884698fa700041da55021
Ruslan Zakirov
ruz at bestpractical.com
Thu Oct 1 21:58:16 EDT 2009
The branch, master has been updated
via ca9b215dfc1eb40b00d884698fa700041da55021 (commit)
via 007bca936823ae9ca678a6b934a7d79ff4658e66 (commit)
from f2e44404d787f161d81dfcf8fa015175810ae401 (commit)
Summary of changes:
lib/HTTP/Server/Simple/Mason.pm | 127 +++++++++++++++++++++++++++++----------
1 files changed, 94 insertions(+), 33 deletions(-)
- Log -----------------------------------------------------------------
commit 007bca936823ae9ca678a6b934a7d79ff4658e66
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Oct 2 03:12:54 2009 +0400
retab
diff --git a/lib/HTTP/Server/Simple/Mason.pm b/lib/HTTP/Server/Simple/Mason.pm
index d087b70..60c9744 100644
--- a/lib/HTTP/Server/Simple/Mason.pm
+++ b/lib/HTTP/Server/Simple/Mason.pm
@@ -79,10 +79,10 @@ sub handle_request {
$cgi->path_info( $cgi->path_info . "/index.html" );
}
- eval { my $m = $self->mason_handler;
-
- $m->handle_cgi_object($cgi) };
-
+ eval {
+ my $m = $self->mason_handler;
+ $m->handle_cgi_object($cgi)
+ };
if ($@) {
my $error = $@;
$self->handle_error($error);
@@ -114,30 +114,30 @@ call it the first time it is called.
sub new_handler {
my $self = shift;
-
+
my $handler_class = $self->handler_class;
my $handler = $handler_class->new(
$self->default_mason_config,
$self->mason_config,
- # Override mason's default output method so
- # we can change the binmode to our encoding if
- # we happen to be handed character data instead
- # of binary data.
- #
- # Cloned from HTML::Mason::CGIHandler
- out_method =>
- sub {
+ # Override mason's default output method so
+ # we can change the binmode to our encoding if
+ # we happen to be handed character data instead
+ # of binary data.
+ #
+ # Cloned from HTML::Mason::CGIHandler
+ out_method => sub {
+ # We use instance here because if we store $request we get a
+ # circular reference and a big memory leak.
my $m = HTML::Mason::Request->instance;
my $r = $m->cgi_request;
+
# Send headers if they have not been sent by us or by user.
- # We use instance here because if we store $request we get a
- # circular reference and a big memory leak.
- unless ($r->http_header_sent) {
- $r->send_http_header();
- }
- {
- $r->content_type || $r->content_type('text/html; charset=utf-8'); # Set up a default
+ $r->send_http_header unless $r->http_header_sent;
+
+ # Set up a default
+ $r->content_type('text/html; charset=utf-8')
+ unless $r->content_type;
if ($r->content_type =~ /charset=([\w-]+)$/ ) {
my $enc = $1;
@@ -152,8 +152,7 @@ sub new_handler {
# wouldn't have to keep checking whether headers have been
# sent and what the $r->method is. That would require
# additions to the Request interface, though.
- print STDOUT grep {defined} @_;
- }
+ print STDOUT grep {defined} @_;
},
@_,
);
commit ca9b215dfc1eb40b00d884698fa700041da55021
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Oct 2 05:51:33 2009 +0400
check status on $m->abort and handle it
Result of $m->abort('xxx') is returned to caller, so
it can be our status.
When we get status or just return from request headers can be
sent allready. In this case it's too late to send custom status
line and we warn about it, unless status is 200.
If headers are not sent then it means we have response without
any content. In this case we send status if it's defined or
"204: No content".
diff --git a/lib/HTTP/Server/Simple/Mason.pm b/lib/HTTP/Server/Simple/Mason.pm
index 60c9744..da42c55 100644
--- a/lib/HTTP/Server/Simple/Mason.pm
+++ b/lib/HTTP/Server/Simple/Mason.pm
@@ -38,8 +38,14 @@ use HTML::Mason::FakeApache;
use Hook::LexWrap;
+our $http_header_sent = 0;
+
wrap 'HTML::Mason::FakeApache::send_http_header', pre => sub {
my $r = shift;
+
+ $http_header_sent = 1;
+ return if $r->http_header_sent;
+
my $status = $r->header_out('Status') || '200 H::S::Mason OK';
print STDOUT "HTTP/1.0 $status\n";
};
@@ -63,30 +69,86 @@ Called with a CGI object. Invokes mason and runs the request
=cut
+my %status_phrase = (
+ '100' => 'Continue',
+ '101' => 'Switching Protocols',
+ '200' => 'OK',
+ '201' => 'Created',
+ '202' => 'Accepted',
+ '203' => 'Non-Authoritative Information',
+ '204' => 'No Content',
+ '205' => 'Reset Content',
+ '206' => 'Partial Content',
+ '300' => 'Multiple Choices',
+ '301' => 'Moved Permanently',
+ '302' => 'Found',
+ '303' => 'See Other',
+ '304' => 'Not Modified',
+ '305' => 'Use Proxy',
+ '307' => 'Temporary Redirect',
+ '400' => 'Bad Request',
+ '401' => 'Unauthorized',
+ '402' => 'Payment Required',
+ '403' => 'Forbidden',
+ '404' => 'Not Found',
+ '405' => 'Method Not Allowed',
+ '406' => 'Not Acceptable',
+ '407' => 'Proxy Authentication Required',
+ '408' => 'Request Time-out',
+ '409' => 'Conflict',
+ '410' => 'Gone',
+ '411' => 'Length Required',
+ '412' => 'Precondition Failed',
+ '413' => 'Request Entity Too Large',
+ '414' => 'Request-URI Too Large',
+ '415' => 'Unsupported Media Type',
+ '416' => 'Requested range not satisfiable',
+ '417' => 'Expectation Failed',
+ '500' => 'Internal Server Error',
+ '501' => 'Not Implemented',
+ '502' => 'Bad Gateway',
+ '503' => 'Service Unavailable',
+ '504' => 'Gateway Time-out',
+ '505' => 'HTTP Version not supported',
+);
+
sub handle_request {
my $self = shift;
my $cgi = shift;
+ local $http_header_sent = 0;
+
+ my $m = $self->mason_handler;
if (
- ( !$self->mason_handler->interp->comp_exists( $cgi->path_info ) )
- && (
- $self->mason_handler->interp->comp_exists(
- $cgi->path_info . "/index.html"
- )
- )
- )
- {
+ !$m->interp->comp_exists( $cgi->path_info )
+ && $m->interp->comp_exists( $cgi->path_info . "/index.html" )
+ ) {
$cgi->path_info( $cgi->path_info . "/index.html" );
}
- eval {
- my $m = $self->mason_handler;
- $m->handle_cgi_object($cgi)
- };
- if ($@) {
- my $error = $@;
- $self->handle_error($error);
- }
+ local $@;
+ my $status = eval { $m->handle_cgi_object($cgi) };
+ if ( my $error = $@ ) {
+ return $self->handle_error($error);
+ }
+
+ if ( $status && $http_header_sent ) {
+ warn "Request has been aborted or declined with status '$status'"
+ .", but it's too late as HTTP headers has been sent already"
+ unless $status =~ /^200(?:\s|$)/;
+ } elsif ( !$http_header_sent ) {
+ # we didn't send anything
+ # at this moment we can not use $m->cgi_request->send_headers
+
+ $status ||= 204; # No Content
+ my ($code, $reason) = split /\s/, $status, 2;
+ $reason ||= $status_phrase{ $status } || 'No reason';
+ print STDOUT "HTTP/1.0 $status $reason\r\n";
+ print STDOUT "Content-Type: text/html; charset='UTF-8'\r\n";
+ print STDOUT "\r\n";
+ print STDOUT "$code: $reason\n";
+ }
+ return;
}
=head2 handle_error ERROR
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list