Changeset 29323

Timestamp:

01/31/09 01:45:11 (4 years ago)

Author:

yappo

Message:

add normal test case

Location:

lang/perl/HTTP-Engine-Middleware/trunk

Files:

• lib/HTTP/Engine/Middleware.pm (modified) (2 diffs)
• lib/HTTP/Engine/Middleware/DebugScreen.pm (modified) (1 diff)
• t/200_middlewares/debugscreen.t (modified) (2 diffs)

lang/perl/HTTP-Engine-Middleware/trunk/lib/HTTP/Engine/Middleware.pm

@@ -20 +20 @@
     is      => 'ro',
     isa     => 'Str',
+);
+
+has 'diecatch' => (
+    is  => 'rw',
+    isa => 'Bool',
 );
 
@@ -177 +182 @@
             }
         }
-        my $res = eval { $handle->($req) };
+        my $res;
+        my $msg;
+        {
+            local $@;
+            $self->diecatch(0);
+            eval { $res = $handle->($req) };
+            $msg = $@ if !$self->diecatch && $@;
+        }
+        die $msg if $msg;
         for my $middleware (reverse @{ $self->middlewares }) {
             my $instance = $self->_instance_of->{$middleware};

lang/perl/HTTP-Engine-Middleware/trunk/lib/HTTP/Engine/Middleware/DebugScreen.pm

@@ -36 +36 @@
     $self->stacktrace_required(0);
 
-    localize_elem '%SIG', '__DIE__' => sub { died($self, @_) } => SUB UP;
+    localize_elem '%SIG', '__DIE__' => sub { $c->diecatch(1); died($self, @_) } => SUB UP;
 
     $req;

lang/perl/HTTP-Engine-Middleware/trunk/t/200_middlewares/debugscreen.t

@@ -8 +8 @@
 plan skip_all => "Scope::Upper is not installed: $@" if $@;
 
-plan tests => 4;
+plan tests => 6;
 
 use HTTP::Engine;
@@ -16 +16 @@
 use HTTP::Engine::Middleware;
 
-my $mw = HTTP::Engine::Middleware->new;
-$mw->install( 'HTTP::Engine::Middleware::DebugScreen', { powerd_by => 'HE::Middleware test' } );
+{
+    my $mw = HTTP::Engine::Middleware->new;
+    $mw->install( 'HTTP::Engine::Middleware::DebugScreen', { powerd_by => 'HE::Middleware test' } );
+    my $res = HTTP::Engine->new(
+        interface => {
+            module          => 'Test',
+            request_handler => $mw->handler(
+                sub { die 'ERROR TEST HE' }
+            ),
+        },
+    )->run( HTTP::Request->new( GET => 'http://localhost/') );
+    my $out = $res->content;
 
-my $res = HTTP::Engine->new(
-    interface => {
-        module          => 'Test',
-        request_handler => $mw->handler(
-            sub { die 'ERROR TEST HE' }
-        ),
-    },
-)->run( HTTP::Request->new( GET => 'http://localhost/') );
-my $out = $res->content;
+    is $res->code, '500';
+    like $out, qr/ERROR TEST HE/;
+    like $out, qr/Powered by HE::Middleware test/;
+    like $out, qr/request_handler => \$mw->handler\(/;
+}
 
-is $res->code, '500';
-like $out, qr/ERROR TEST HE/;
-like $out, qr/Powered by HE::Middleware test/;
-like $out, qr/request_handler => \$mw->handler\(/;
+{
+    my $mw = HTTP::Engine::Middleware->new;
+    $mw->install();
+    my $res = HTTP::Engine->new(
+        interface => {
+            module          => 'Test',
+            request_handler => $mw->handler(
+                sub { die 'ERROR TEST HE' }
+            ),
+        },
+    )->run( HTTP::Request->new( GET => 'http://localhost/') );
+    my $out = $res->content;
+
+    is $res->code, '500';
+    is $out, 'internal server errror';
+}