cleanup

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

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index c092d50..969021b 100644 (file)
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -357,8 +357,10 @@ sub handler ($$) {
     # Always expect worst case!
     my $status = -1;
     eval {
+        my @stats = ();
         my $handler = sub {
-            my $c         = $class->prepare($r);
+            my $c = $class->prepare($r);
+            $c->{stats} = \@stats;
             my $action    = $c->req->action;
             my $namespace = '';
             $namespace = ( join( '/', @{ $c->req->args } ) || '/' )
@@ -400,7 +402,7 @@ sub handler ($$) {
             ( $elapsed, $status ) = $class->benchmark($handler);
             $elapsed = sprintf '%f', $elapsed;
             my $av = sprintf '%.3f', 1 / $elapsed;
-            $class->log->info( "Request took $elapsed" . "s ($av/s)" );
+            $class->log->info( "Request took $elapsed" . "s ($av/s)", @stats );
         }
         else { $status = &$handler }
     };
@@ -464,9 +466,9 @@ 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 "' . join( ' ', @params ) . '"' );
+        $c->log->debug( 'Parameters are', @params );
     }
     $c->prepare_uploads;
     return $c;
@@ -586,11 +588,12 @@ sub execute {
     eval {
         if ( $c->debug )
         {
-            my $action = $c->actions->{reverse}->{"$code"} || "$code";
+            my $action = $c->actions->{reverse}->{"$code"};
+            $action = "/$action" unless $action =~ /\-\>/;
             my ( $elapsed, @state ) =
               $c->benchmark( $code, $class, $c, @{ $c->req->args } );
-            $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
-              if $c->debug;
+            push @{ $c->{stats} },
+              _prettify( $action, '', sprintf( '%fs', $elapsed ) );
             $c->state(@state);
         }
         else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
@@ -668,8 +671,6 @@ sub set_action {
     my $uid = $parent->getUID;
     $c->actions->{private}->{$uid}->{$method} = [ $namespace, $code ];
     my $forward = $prefix ? "$prefix/$method" : $method;
-    $c->log->debug(qq|Private "/$forward" is "$namespace->$method"|)
-      if $c->debug;
 
     if ( $flags{path} ) {
         $flags{path} =~ s/^\w+//;
@@ -684,7 +685,7 @@ sub set_action {
         if ( $flags{regex} =~ /^"(.*)"$/ ) { $flags{regex} = $1 }
     }
 
-    my $reverse = $prefix ? "$method ($prefix)" : $method;
+    my $reverse = $prefix ? "$prefix/$method" : $method;
 
     if ( $flags{local} || $flags{global} || $flags{path} ) {
         my $path = $flags{path} || $method;
@@ -696,12 +697,10 @@ sub set_action {
         $absolute = 1 if $flags{global};
         my $name = $absolute ? $path : "$prefix/$path";
         $c->actions->{plain}->{$name} = [ $namespace, $code ];
-        $c->log->debug(qq|Public "/$name" is "/$forward"|) if $c->debug;
     }
     if ( my $regex = $flags{regex} ) {
         push @{ $c->actions->{compiled} }, [ $regex, qr#$regex# ];
         $c->actions->{regex}->{$regex} = [ $namespace, $code ];
-        $c->log->debug(qq|Public "$regex" is "/$forward"|) if $c->debug;
     }
 
     $c->actions->{reverse}->{"$code"} = $reverse;
@@ -791,10 +790,38 @@ sub setup_components {
         $self->components->{ ref $comp } = $comp;
         $self->setup_actions($comp);
     }
-    $self->log->debug( 'Initialized components "'
-          . join( ' ', keys %{ $self->components } )
-          . '"' )
-      if $self->debug;
+    my @comps;
+    push @comps, "  $_" for keys %{ $self->components };
+    $self->log->debug( 'Loaded components', @comps )
+      if ( @comps && $self->debug );
+    my $actions  = $self->actions;
+    my @messages = ('Loaded private actions');
+    my $walker   = sub {
+        my ( $walker, $parent, $messages, $prefix ) = @_;
+        $prefix .= $parent->getNodeValue || '';
+        $prefix .= '/' unless $prefix =~ /\/$/;
+        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 );
+        }
+        $walker->( $walker, $_, $messages, $prefix )
+          for $parent->getAllChildren;
+    };
+    $walker->( $walker, $self->tree, \@messages, '' );
+    $self->log->debug(@messages) if ( $#messages && $self->debug );
+    @messages = ('Loaded plain actions');
+    for my $plain ( sort keys %{ $actions->{plain} } ) {
+        my ( $class, $code ) = @{ $actions->{plain}->{$plain} };
+        push @messages, _prettify( "/$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 );
+    }
+    $self->log->debug(@messages) if ( $#messages && $self->debug );
 }
 
 =item $c->stash
@@ -834,6 +861,16 @@ sub _class2prefix {
     return $prefix;
 }
 
+sub _prettify {
+    my ( $val1, $val2, $val3 ) = @_;
+    formline
+'  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>>>>>>>> ',
+      $val1, $val2, $val3;
+    my $formatted = $^A;
+    $^A = '';
+    return $formatted;
+}
+
 =back
 
 =head1 AUTHOR