Fixed engine detection to allow custom mod_perl engines

[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index dc56b88..7310d71 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -44,7 +44,7 @@ our $DETACH    = "catalyst_detach\n";
 require Module::Pluggable::Fast;
 
 # Helper script generation
-our $CATALYST_SCRIPT_GEN = 24;
+our $CATALYST_SCRIPT_GEN = 25;
 
 __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log dispatcher_class
@@ -592,7 +592,9 @@ EOF
 
         {
             no strict 'refs';
-            @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
+            @plugins = 
+                map  { $_ . ' ' . ( $_->VERSION || '' ) }
+                grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
         }
 
         if (@plugins) {
@@ -923,6 +925,7 @@ sub execute {
             push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
         }
     }
+    my $last = ${ $c->stack }[-1];
     pop( @{ $c->stack } );
 
     if ( my $error = $@ ) {
@@ -931,7 +934,9 @@ sub execute {
         else {
             unless ( ref $error ) {
                 chomp $error;
-                $error = qq/Caught exception "$error"/;
+                my $class = $last->class;
+                my $name  = $last->name;
+                $error = qq/Caught exception in $class->$name "$error"/;
             }
             $c->error($error);
             $c->state(0);
@@ -1016,19 +1021,18 @@ sub finalize_headers {
 
     # Content-Length
     if ( $c->response->body && !$c->response->content_length ) {
+
         # get the length from a filehandle
         if ( ref $c->response->body && $c->response->body->can('read') ) {
             if ( my $stat = stat $c->response->body ) {
                 $c->response->content_length( $stat->size );
             }
             else {
-                $c->log->warn( 
-                    'Serving filehandle without a content-length' );
+                $c->log->warn('Serving filehandle without a content-length');
             }
         }
         else {
-            $c->response->content_length( 
-                bytes::length( $c->response->body ) );
+            $c->response->content_length( bytes::length( $c->response->body ) );
         }
     }
 
@@ -1555,7 +1559,7 @@ sub setup_engine {
         $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
     }
 
-    if ( !$engine && $ENV{MOD_PERL} ) {
+    if ( $ENV{MOD_PERL} ) {
 
         # create the apache method
         {
@@ -1571,21 +1575,25 @@ sub setup_engine {
 
         if ( $software eq 'mod_perl' ) {
 
-            if ( $version >= 1.99922 ) {
-                $engine = 'Catalyst::Engine::Apache2::MP20';
-            }
-
-            elsif ( $version >= 1.9901 ) {
-                $engine = 'Catalyst::Engine::Apache2::MP19';
-            }
-
-            elsif ( $version >= 1.24 ) {
-                $engine = 'Catalyst::Engine::Apache::MP13';
-            }
+            if ( !$engine ) {
+                
+                if ( $version >= 1.99922 ) {
+                    $engine = 'Catalyst::Engine::Apache2::MP20';
+                }
+    
+                elsif ( $version >= 1.9901 ) {
+                    $engine = 'Catalyst::Engine::Apache2::MP19';
+                }
+    
+                elsif ( $version >= 1.24 ) {
+                    $engine = 'Catalyst::Engine::Apache::MP13';
+                }
+    
+                else {
+                    Catalyst::Exception->throw( message =>
+                          qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
+                }
 
-            else {
-                Catalyst::Exception->throw( message =>
-                      qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
             }
 
             # install the correct mod_perl handler