X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine.pm;h=370ff5e012d0bdec323aefa04820dcd2538a3423;hb=91dc9907365d9a8b25836d3c3bf68683af18eb7d;hp=98a5f924d6c6f002e0a4366f61a20bfb431cc5c9;hpb=49490aabb7ab968b286f283d03c1816954c92e1f;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index 98a5f92..370ff5e 100644
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -127,15 +127,17 @@ sub execute {
     my ( $c, $class, $code ) = @_;
     $class = $c->comp($class) || $class;
     $c->state(0);
+    my $callsub = ( caller(1) )[3];
     eval {
         if ( $c->debug )
         {
             my $action = $c->actions->{reverse}->{"$code"};
             $action = "/$action" unless $action =~ /\-\>/;
+            $action = "-> $action" if $callsub =~ /forward$/;
             my ( $elapsed, @state ) =
               $c->benchmark( $code, $class, $c, @{ $c->req->args } );
             push @{ $c->{stats} },
-              _prettify( $action, sprintf( '%fs', $elapsed ), '' );
+              _prettify_stats( $action, sprintf( '%fs', $elapsed ), '' );
             $c->state(@state);
         }
         else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
@@ -164,19 +166,19 @@ sub finalize {
     if ( my $location = $c->response->redirect ) {
         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
         $c->response->header( Location => $location );
-        $c->response->status(302);
+        $c->response->status(302) if $c->response->status !~ /3\d\d$/;
     }
 
     if ( $#{ $c->error } >= 0 ) {
         $c->finalize_error;
     }
 
-    if ( !$c->response->output && $c->response->status !~ /^(1|3)\d\d)$/ ) {
+    if ( !$c->response->output && $c->response->status !~ /^(1|3)\d\d$/ ) {
         $c->finalize_error;
     }
 
-    if ( $c->response->output ) {
-        use bytes; # play safe with a utf8 aware perl
+    if ( $c->response->output && !$c->response->content_length ) {
+        use bytes;    # play safe with a utf8 aware perl
         $c->response->content_length( length $c->response->output );
     }
 
@@ -546,7 +548,7 @@ sub prepare {
         my @params;
         for my $key ( keys %{ $c->req->params } ) {
             my $value = $c->req->params->{$key} || '';
-            push @params, "  $key=$value";
+            push @params, "  + $key=$value";
         }
         $c->log->debug( 'Parameters are', @params );
     }
@@ -843,7 +845,7 @@ sub setup_components {
         $self->setup_actions($comp);
     }
     my @comps;
-    push @comps, "  $_" for keys %{ $self->components };
+    push @comps, "  + $_" for keys %{ $self->components };
     $self->log->debug( 'Loaded components', @comps )
       if ( @comps && $self->debug );
     my $actions  = $self->actions;
@@ -855,7 +857,8 @@ sub setup_components {
         my $uid = $parent->getUID;
         for my $action ( keys %{ $actions->{private}->{$uid} } ) {
             my ( $class, $code ) = @{ $actions->{private}->{$uid}->{$action} };
-            push @$messages, _prettify( "$prefix$action", $class, $code );
+            push @$messages,
+              _prettify_action( "$prefix$action", $class, $code );
         }
         $walker->( $walker, $_, $messages, $prefix )
           for $parent->getAllChildren;
@@ -865,13 +868,13 @@ sub setup_components {
     @messages = ('Loaded plain actions');
     for my $plain ( sort keys %{ $actions->{plain} } ) {
         my ( $class, $code ) = @{ $actions->{plain}->{$plain} };
-        push @messages, _prettify( "/$plain", $class, $code );
+        push @messages, _prettify_action( "/$plain", $class, $code );
     }
     $self->log->debug(@messages) if ( $#messages && $self->debug );
     @messages = ('Loaded regex actions');
     for my $regex ( sort keys %{ $actions->{regex} } ) {
         my ( $class, $code ) = @{ $actions->{regex}->{$regex} };
-        push @messages, _prettify( $regex, $class, $code );
+        push @messages, _prettify_action( $regex, $class, $code );
     }
     $self->log->debug(@messages) if ( $#messages && $self->debug );
 }
@@ -913,11 +916,19 @@ sub _class2prefix {
     return $prefix;
 }
 
-sub _prettify {
+sub _prettify_action {
     my ( $val1, $val2, $val3 ) = @_;
-    formline
-'  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>>>>>>>>  ',
-      $val1, $val2, $val3;
+    formline '  + @<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
+      . ' @>>>>>>>>>>>>>>  ', $val1, $val2, $val3;
+    my $formatted = $^A;
+    $^A = '';
+    return $formatted;
+}
+
+sub _prettify_stats {
+    my ( $val1, $val2 ) = @_;
+    formline '  + @<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<< ',
+      $val1, $val2;
     my $formatted = $^A;
     $^A = '';
     return $formatted;