r45957 - in /branches/upstream/libhttp-server-simple-mason-perl/current: Changes MANIFEST MANIFEST.SKIP META.yml SIGNATURE lib/HTTP/Server/Simple/Mason.pm t/01live.t t/04unhandlederrors.t t/05handlederrors.t

angelabad-guest at users.alioth.debian.org angelabad-guest at users.alioth.debian.org
Sun Oct 18 00:29:05 UTC 2009


Author: angelabad-guest
Date: Sun Oct 18 00:28:57 2009
New Revision: 45957

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45957
Log:
[svn-upgrade] Integrating new upstream version, libhttp-server-simple-mason-perl (0.13)

Added:
    branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST.SKIP
Modified:
    branches/upstream/libhttp-server-simple-mason-perl/current/Changes
    branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST
    branches/upstream/libhttp-server-simple-mason-perl/current/META.yml
    branches/upstream/libhttp-server-simple-mason-perl/current/SIGNATURE
    branches/upstream/libhttp-server-simple-mason-perl/current/lib/HTTP/Server/Simple/Mason.pm
    branches/upstream/libhttp-server-simple-mason-perl/current/t/01live.t
    branches/upstream/libhttp-server-simple-mason-perl/current/t/04unhandlederrors.t
    branches/upstream/libhttp-server-simple-mason-perl/current/t/05handlederrors.t

Modified: branches/upstream/libhttp-server-simple-mason-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-server-simple-mason-perl/current/Changes?rev=45957&op=diff
==============================================================================
--- branches/upstream/libhttp-server-simple-mason-perl/current/Changes (original)
+++ branches/upstream/libhttp-server-simple-mason-perl/current/Changes Sun Oct 18 00:28:57 2009
@@ -1,3 +1,9 @@
+0.13 Fri Oct  9 15:01:07 EDT 2009
+
+    * Better cleanup temp files after tests
+    * No longer add a double / in the path when testing for index.html
+    * Better support for sending custom HTTP statuses in $m->abort
+
 0.12 Tue Jul  7 17:01:55 EDT 2009
     * Test update. Looks like LWP::Simple now returns undef instead of '' on fail
 

Modified: branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST?rev=45957&op=diff
==============================================================================
--- branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST (original)
+++ branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST Sun Oct 18 00:28:57 2009
@@ -11,6 +11,7 @@
 lib/HTTP/Server/Simple/Mason.pm
 Makefile.PL
 MANIFEST			This list of files
+MANIFEST.SKIP
 META.yml
 SIGNATURE
 t/00smoke.t

Added: branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST.SKIP?rev=45957&op=file
==============================================================================
--- branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libhttp-server-simple-mason-perl/current/MANIFEST.SKIP Sun Oct 18 00:28:57 2009
@@ -1,0 +1,11 @@
+TODO
+^Makefile$
+blib
+pm_to_blib
+.swp$
+~$
+.tmp$
+.bak$
+.git/
+.gitignore$
+.shipit$

Modified: branches/upstream/libhttp-server-simple-mason-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-server-simple-mason-perl/current/META.yml?rev=45957&op=diff
==============================================================================
--- branches/upstream/libhttp-server-simple-mason-perl/current/META.yml (original)
+++ branches/upstream/libhttp-server-simple-mason-perl/current/META.yml Sun Oct 18 00:28:57 2009
@@ -23,4 +23,4 @@
   Hook::LexWrap: 0
 resources:
   license: http://dev.perl.org/licenses/
-version: 0.12
+version: 0.13

Modified: branches/upstream/libhttp-server-simple-mason-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-server-simple-mason-perl/current/SIGNATURE?rev=45957&op=diff
==============================================================================
--- branches/upstream/libhttp-server-simple-mason-perl/current/SIGNATURE (original)
+++ branches/upstream/libhttp-server-simple-mason-perl/current/SIGNATURE Sun Oct 18 00:28:57 2009
@@ -14,9 +14,10 @@
 -----BEGIN PGP SIGNED MESSAGE-----
 Hash: SHA1
 
-SHA1 ebcbdf33acf9729ac67cb50103ee45de6e3cfedc Changes
-SHA1 2a372858cf977048b613139a8b38fe6078c66365 MANIFEST
-SHA1 ad044381ba10c04b8f75c624291c39076e4771a5 META.yml
+SHA1 58a84cdc4f1a68d621a173222b8f156748ec8868 Changes
+SHA1 1907f0caadc642dede735a41860b342ce5cae1bc MANIFEST
+SHA1 e476d8bd724d46eb9e255cc8afc98b92269e2255 MANIFEST.SKIP
+SHA1 2b2897c7e56142ec0769a2d3f067937d5e080019 META.yml
 SHA1 86fbfbd339277162b49efdd58a0568c6895ec300 Makefile.PL
 SHA1 02be3a74017679a35b0df586169777fa305664a7 ex/sample_server.pl
 SHA1 fd5f3c4f0418efee3b9b16cf8c3902e8374909df inc/Module/Install.pm
@@ -27,17 +28,17 @@
 SHA1 12bf1867955480d47d5171a9e9c6a96fabe0b58f inc/Module/Install/Metadata.pm
 SHA1 f7ee667e878bd2faf22ee9358a7b5a2cc8e91ba4 inc/Module/Install/Win32.pm
 SHA1 8ed29d6cf217e0977469575d788599cbfb53a5ca inc/Module/Install/WriteAll.pm
-SHA1 06b63bcabbca0759974845e55e40606adb14a0e9 lib/HTTP/Server/Simple/Mason.pm
+SHA1 c5b2a151ab1be93339c916fd64a598779416b2ed lib/HTTP/Server/Simple/Mason.pm
 SHA1 c465222b356e9f0af0721ac0e6473eb534f2d90c t/00smoke.t
-SHA1 862ae0d597b31748124f37861fbc86a8329865aa t/01live.t
+SHA1 6667b5a7d2c5c1c9582930d8eb784fbea15672e5 t/01live.t
 SHA1 aca95653cfce68912e08c57b3a4566207e2f99b3 t/02pod.t
 SHA1 90f0be3e6b0fab021155953742f5cc5c5e47a5aa t/03podcoverage.t
-SHA1 b87e30384e82bdd6aba8ca00c2bff84599ad17af t/04unhandlederrors.t
-SHA1 5ffdb15e2d3a267b3ecb64a02bc4e4e96d2a1f13 t/05handlederrors.t
+SHA1 1562a9be9217ee832f2e12d7b7992438b878044c t/04unhandlederrors.t
+SHA1 69ac9d80ff673410c3fd19b832c2828b0ed85648 t/05handlederrors.t
 -----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.4.9 (Darwin)
+Version: GnuPG v1.4.9 (GNU/Linux)
 
-iEYEARECAAYFAkpTuCUACgkQEi9d9xCOQEbx3ACfVaf3t40aR2BYJvUXZ+kDzF99
-Hl0An3HuPqpmHKJsNfi7BNtYNhFZp7zI
-=Q7tB
+iEYEARECAAYFAkrPiYsACgkQEi9d9xCOQEY4hQCeMbt+emsNJb8tyTQcD7OYTycw
+0UoAoJKE2zsoiNhIW1cIY9KJGFoKvFkn
+=OXUc
 -----END PGP SIGNATURE-----

Modified: branches/upstream/libhttp-server-simple-mason-perl/current/lib/HTTP/Server/Simple/Mason.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-server-simple-mason-perl/current/lib/HTTP/Server/Simple/Mason.pm?rev=45957&op=diff
==============================================================================
--- branches/upstream/libhttp-server-simple-mason-perl/current/lib/HTTP/Server/Simple/Mason.pm (original)
+++ branches/upstream/libhttp-server-simple-mason-perl/current/lib/HTTP/Server/Simple/Mason.pm Sun Oct 18 00:28:57 2009
@@ -1,7 +1,7 @@
 package HTTP::Server::Simple::Mason;
 use base qw/HTTP::Server::Simple::CGI/;
 use strict;
-our $VERSION = '0.12';
+our $VERSION = '0.13';
 
 =head1 NAME
 
@@ -38,8 +38,14 @@
 
 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,87 @@
 
 =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;
 
-    if (
-        ( !$self->mason_handler->interp->comp_exists( $cgi->path_info ) )
-        && (
-            $self->mason_handler->interp->comp_exists(
-                $cgi->path_info . "/index.html"
-            )
-        )
-      )
-    {
-        $cgi->path_info( $cgi->path_info . "/index.html" );
+    local $http_header_sent = 0;
+
+    my $m = $self->mason_handler;
+    unless ( $m->interp->comp_exists( $cgi->path_info ) ) {
+        my $path = $cgi->path_info;
+        $path .= '/' unless $path =~ m{/$};
+        $path .= 'index.html';
+        $cgi->path_info( $path )
+            if $m->interp->comp_exists( $path );
     }
 
-    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
@@ -114,30 +177,30 @@
 
 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 +215,7 @@
             # 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} @_;
         },
         @_,
     );

Modified: branches/upstream/libhttp-server-simple-mason-perl/current/t/01live.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-server-simple-mason-perl/current/t/01live.t?rev=45957&op=diff
==============================================================================
--- branches/upstream/libhttp-server-simple-mason-perl/current/t/01live.t (original)
+++ branches/upstream/libhttp-server-simple-mason-perl/current/t/01live.t Sun Oct 18 00:28:57 2009
@@ -8,9 +8,11 @@
     }
 }
 
-use_ok( HTTP::Server::Simple::Mason);
+use_ok(HTTP::Server::Simple::Mason);
 
-my $s=MyApp::Server->new(13432);
+use File::Temp qw/tempdir/;
+my $mason_root = tempdir( CLEANUP => 1 );
+my $s=MyApp::Server->new(13432, $mason_root);
 is($s->port(),13432,"Constructor set port correctly");
 my $pid=$s->background();
 like($pid, qr/^-?\d+$/,'pid is numeric');
@@ -20,16 +22,19 @@
 is(kill(9,$pid),1,'Signaled 1 process successfully');
 
 
-
-
 package MyApp::Server;
 use base qw/HTTP::Server::Simple::Mason/;
 use File::Spec;
 
-use File::Temp qw/tempdir/;
+my $root;
+sub new {
+    $root = $_[2];
+    return shift->SUPER::new( @_ );
+}
+
 sub mason_config {
-    my $root = tempdir( CLEANUP => 1 );
-    open (PAGE, '>', File::Spec->catfile($root, 'index.html')) or die $!;
+    open (PAGE, '>', File::Spec->catfile($root, 'index.html'))
+        or die $!;
     print PAGE '<%1+1%>';
     close (PAGE);
     return ( comp_root => $root );

Modified: branches/upstream/libhttp-server-simple-mason-perl/current/t/04unhandlederrors.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-server-simple-mason-perl/current/t/04unhandlederrors.t?rev=45957&op=diff
==============================================================================
--- branches/upstream/libhttp-server-simple-mason-perl/current/t/04unhandlederrors.t (original)
+++ branches/upstream/libhttp-server-simple-mason-perl/current/t/04unhandlederrors.t Sun Oct 18 00:28:57 2009
@@ -10,7 +10,9 @@
 
 use_ok( HTTP::Server::Simple::Mason);
 
-my $s=MyApp::Server->new(13432);
+use File::Temp qw/tempdir/;
+my $mason_root = tempdir( CLEANUP => 1 );
+my $s=MyApp::Server->new(13432, $mason_root);
 is($s->port(),13432,"Constructor set port correctly");
 my $pid=$s->background();
 like($pid, qr/^-?\d+$/,'pid is numeric');
@@ -25,10 +27,14 @@
 package MyApp::Server;
 use base qw/HTTP::Server::Simple::Mason/;
 use File::Spec;
-use File::Temp qw/tempdir/;
+
+my $root;
+sub new {
+    $root = $_[2];
+    return shift->SUPER::new( @_ );
+}
 
 sub mason_config {
-    my $root =  tempdir( CLEANUP => 1 );
     open (PAGE, '>', File::Spec->catfile($root, 'index.html')) or die $!;
     print PAGE '<%die%>';
     close (PAGE);

Modified: branches/upstream/libhttp-server-simple-mason-perl/current/t/05handlederrors.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-server-simple-mason-perl/current/t/05handlederrors.t?rev=45957&op=diff
==============================================================================
--- branches/upstream/libhttp-server-simple-mason-perl/current/t/05handlederrors.t (original)
+++ branches/upstream/libhttp-server-simple-mason-perl/current/t/05handlederrors.t Sun Oct 18 00:28:57 2009
@@ -10,7 +10,9 @@
 
 use_ok( HTTP::Server::Simple::Mason);
 
-my $s=MyApp::Server->new(13432);
+use File::Temp qw/tempdir/;
+my $mason_root = tempdir( CLEANUP => 1 );
+my $s=MyApp::Server->new(13432, $mason_root);
 is($s->port(),13432,"Constructor set port correctly");
 my $pid=$s->background();
 like($pid, qr/^-?\d+$/,'pid is numeric');
@@ -25,10 +27,14 @@
 package MyApp::Server;
 use base qw/HTTP::Server::Simple::Mason/;
 use File::Spec;
-use File::Temp qw/tempdir/;
+
+my $root;
+sub new {
+    $root = $_[2];
+    return shift->SUPER::new( @_ );
+}
 
 sub mason_config {
-    my $root = tempdir(CLEANUP => 1);
     open (PAGE, '>', File::Spec->catfile($root, 'index.html')) or die $!;
     print PAGE '<%die%>';
     close (PAGE);




More information about the Pkg-perl-cvs-commits mailing list