X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=42cbe8f4a9e4a2027fd40057f8755149efdde502;hp=33e88dbe417e95dd6f26121fb991132ed7ba1cba;hb=22247e54ccd3fbdaf286e77304b96e61ecc43a0f;hpb=e3a1377127efe66e918a24b9fa5275a3d2aa51e0

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 33e88db..42cbe8f 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -10,12 +10,15 @@ use Catalyst::Request;
 use Catalyst::Request::Upload;
 use Catalyst::Response;
 use Catalyst::Utils;
+use File::stat;
 use NEXT;
 use Text::SimpleTable;
 use Path::Class;
 use Time::HiRes qw/gettimeofday tv_interval/;
 use URI;
 use Scalar::Util qw/weaken/;
+use Tree::Simple qw/use_weak_refs/;
+use Tree::Simple::Visitor::FindByUID;
 use attributes;
 
 __PACKAGE__->mk_accessors(
@@ -43,7 +46,7 @@ our $DETACH    = "catalyst_detach\n";
 require Module::Pluggable::Fast;
 
 # Helper script generation
-our $CATALYST_SCRIPT_GEN = 11;
+our $CATALYST_SCRIPT_GEN = 25;
 
 __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log dispatcher_class
@@ -54,7 +57,7 @@ __PACKAGE__->engine_class('Catalyst::Engine::CGI');
 __PACKAGE__->request_class('Catalyst::Request');
 __PACKAGE__->response_class('Catalyst::Response');
 
-our $VERSION = '5.49_05';
+our $VERSION = '5.62';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -98,17 +101,18 @@ Catalyst - The Elegant MVC Web Application Framework
     use Catalyst qw/-Debug/; # include plugins here as well
     
     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
-        my ( $self, $c, @args ) = @_; # args are qw/on you/ for /foo/on/you
-        $c->stash->{template} = 'foo.tt';
+        my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
+        $c->stash->{template} = 'foo.tt'; # set the template
         # lookup something from db -- stash vars are passed to TT
-        $c->stash->{data} = MyApp::Model::Database::Foo->search;
+        $c->stash->{data} = 
+          MyApp::Model::Database::Foo->search( { country => $args[0] } );
         if ( $c->req->params->{bar} ) { # access GET or POST parameters
             $c->forward( 'bar' ); # process another action
             # do something else after forward returns            
         }
     }
     
-    # The foo.tt TT template can easily use the stash data from the database
+    # The foo.tt TT template can use the stash data from the database
     [% WHILE (item = data.next) %]
         [% item.foo %]
     [% END %]
@@ -116,17 +120,17 @@ Catalyst - The Elegant MVC Web Application Framework
     # called for /bar/of/soap, /bar/of/soap/10, etc.
     sub bar : Path('/bar/of/soap') { ... }
 
-    # called for all actions, from the top-most controller inwards
+    # called for all actions, from the top-most controller downwards
     sub auto : Private { 
         my ( $self, $c ) = @_;
         if ( !$c->user ) {
             $c->res->redirect( '/login' ); # require login
             return 0; # abort request and go immediately to end()
         }
-        return 1;
+        return 1; # success; carry on to next action
     }
     
-    # called after the main action is finished
+    # called after all actions are finished
     sub end : Private { 
         my ( $self, $c ) = @_;
         if ( scalar @{ $c->error } ) { ... } # handle errors
@@ -166,81 +170,79 @@ The key concept of Catalyst is DRY (Don't Repeat Yourself).
 
 See L<Catalyst::Manual> for more documentation.
 
-Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
-Omit the C<Catalyst::Plugin::> prefix from the plugin name, i.e.,
-C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
+Catalyst plugins can be loaded by naming them as arguments to the "use
+Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
+plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
+C<My::Module>.
 
     use Catalyst qw/My::Module/;
 
-Special flags like -Debug and -Engine can also be specified as arguments when
-Catalyst is loaded:
+Special flags like C<-Debug> and C<-Engine> can also be specified as
+arguments when Catalyst is loaded:
 
     use Catalyst qw/-Debug My::Module/;
 
-The position of plugins and flags in the chain is important, because they are
-loaded in exactly the order that they appear.
+The position of plugins and flags in the chain is important, because
+they are loaded in exactly the order in which they appear.
 
 The following flags are supported:
 
-=over 4
-
-=item -Debug
+=head2 -Debug
 
 Enables debug output.
 
-=item -Engine
+=head2 -Engine
 
-Forces Catalyst to use a specific engine.
-Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
+Forces Catalyst to use a specific engine. Omit the
+C<Catalyst::Engine::> prefix of the engine name, i.e.:
 
     use Catalyst qw/-Engine=CGI/;
 
-=item -Home
+=head2 -Home
 
-Forces Catalyst to use a specific home directory.
+Forces Catalyst to use a specific home directory, e.g.:
 
-=item -Log
+    use Catalyst qw[-Home=/usr/sri];
 
-Specifies log level.
+=head2 -Log
 
-=back
+Specifies log level.
 
 =head1 METHODS
 
 =head2 Information about the current request
 
-=over 4
+=head2 $c->action
 
-=item $c->action
+Returns a L<Catalyst::Action> object for the current action, which
+stringifies to the action name. See L<Catalyst::Action>.
 
-Returns a L<Catalyst::Action> object for the current action, which stringifies to the action name.
+=head2 $c->namespace
 
-=item $c->namespace
+Returns the namespace of the current action, i.e., the uri prefix
+corresponding to the controller of the current action. For example:
 
-Returns the namespace of the current action, i.e., the uri prefix corresponding to the 
-controller of the current action.
+    # in Controller::Foo::Bar
+    $c->namespace; # returns 'foo/bar';
 
-=item $c->request
+=head2 $c->request
 
-=item $c->req
+=head2 $c->req
 
-Returns the current L<Catalyst::Request> object.
-
-=back
+Returns the current L<Catalyst::Request> object. See
+L<Catalyst::Request>.
 
 =head2 Processing and response to the current request
 
-=over 4
-
-=item $c->forward( $action [, \@arguments ] )
+=head2 $c->forward( $action [, \@arguments ] )
 
-=item $c->forward( $class, $method, [, \@arguments ] )
+=head2 $c->forward( $class, $method, [, \@arguments ] )
 
-Forwards processing to a private action. If you give a class name but 
-no method, process() is called. You may also optionally pass arguments 
-in an arrayref. The action will receive the arguments in @_ and $c->req->args. 
-Upon returning from the function, $c->req->args will be restored to the previous
-values.
+Forwards processing to a private action. If you give a class name but no
+method, C<process()> is called. You may also optionally pass arguments
+in an arrayref. The action will receive the arguments in C<@_> and
+C<$c-E<gt>req-E<gt>args>. Upon returning from the function,
+C<$c-E<gt>req-E<gt>args> will be restored to the previous values.
 
     $c->forward('/foo');
     $c->forward('index');
@@ -251,9 +253,9 @@ values.
 
 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
 
-=item $c->detach( $action [, \@arguments ] )
+=head2 $c->detach( $action [, \@arguments ] )
 
-=item $c->detach( $class, $method, [, \@arguments ] )
+=head2 $c->detach( $class, $method, [, \@arguments ] )
 
 The same as C<forward>, but doesn't return.
 
@@ -261,13 +263,15 @@ The same as C<forward>, but doesn't return.
 
 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 
-=item $c->error
+=head2 $c->error
 
-=item $c->error($error, ...)
+=head2 $c->error($error, ...)
 
-=item $c->error($arrayref)
+=head2 $c->error($arrayref)
 
-Returns an arrayref containing error messages.
+Returns an arrayref containing error messages.  If Catalyst encounters an
+error while processing a request, it stores the error in $c->error.  This
+method should not be used to store non-fatal error messages.
 
     my @error = @{ $c->error };
 
@@ -275,7 +279,8 @@ Add a new error.
 
     $c->error('Something bad happened');
 
-Clear errors.
+Clear errors.  You probably don't want to clear the errors unless you are
+implementing a custom error screen.
 
     $c->error(0);
 
@@ -291,17 +296,19 @@ sub error {
     return $c->{error} || [];
 }
 
-=item $c->response
+=head2 $c->response
 
-=item $c->res
+=head2 $c->res
 
 Returns the current L<Catalyst::Response> object.
 
-=item $c->stash
+=head2 $c->stash
 
-Returns a hashref to the stash, which may be used to store data and pass it
-between components. You can also set hash keys by passing arguments.  The
-stash is automatically sent to the view.
+Returns a hashref to the stash, which may be used to store data and pass
+it between components during a request. You can also set hash keys by
+passing arguments. The stash is automatically sent to the view. The
+stash is cleared at the end of a request; it cannot be used for
+persistent storage.
 
     $c->stash->{foo} = $bar;
     $c->stash( { moose => 'majestic', qux => 0 } );
@@ -323,22 +330,20 @@ sub stash {
     return $c->{stash};
 }
 
-=item $c->state
+=head2 $c->state
 
 Contains the return value of the last executed action.
 
-=back
-
 =head2 Component Accessors
 
-=over 4
+=head2 $c->comp($name)
 
-=item $c->comp($name)
+=head2 $c->component($name)
 
-=item $c->component($name)
-
-Gets a component object by name.  This method is no longer recommended.
-$c->controller, $c->model, and $c->view should be used instead.
+Gets a component object by name. This method is no longer recommended,
+unless you want to get a specific component by full
+class. C<$c-E<gt>controller>, C<$c-E<gt>model>, and C<$c-E<gt>view>
+should be used instead.
 
 =cut
 
@@ -361,13 +366,23 @@ sub component {
 
             if ( exists $c->components->{$try} ) {
 
-                return $c->components->{$try};
+                my $comp = $c->components->{$try};
+                if ( ref $comp && $comp->can('ACCEPT_CONTEXT') ) {
+                    return $comp->ACCEPT_CONTEXT($c);
+                }
+                else { return $comp }
             }
         }
 
         foreach my $component ( keys %{ $c->components } ) {
-
-            return $c->components->{$component} if $component =~ /$name/i;
+            my $comp;
+            $comp = $c->components->{$component} if $component =~ /$name/i;
+            if ($comp) {
+                if ( ref $comp && $comp->can('ACCEPT_CONTEXT') ) {
+                    return $comp->ACCEPT_CONTEXT($c);
+                }
+                else { return $comp }
+            }
         }
 
     }
@@ -375,7 +390,7 @@ sub component {
     return sort keys %{ $c->components };
 }
 
-=item $c->controller($name)
+=head2 $c->controller($name)
 
 Gets a L<Catalyst::Controller> instance by name.
 
@@ -386,11 +401,11 @@ Gets a L<Catalyst::Controller> instance by name.
 sub controller {
     my ( $c, $name ) = @_;
     my $controller = $c->comp("Controller::$name");
-    return $controller if $controller;
+    return $controller if defined $controller;
     return $c->comp("C::$name");
 }
 
-=item $c->model($name)
+=head2 $c->model($name)
 
 Gets a L<Catalyst::Model> instance by name.
 
@@ -401,11 +416,11 @@ Gets a L<Catalyst::Model> instance by name.
 sub model {
     my ( $c, $name ) = @_;
     my $model = $c->comp("Model::$name");
-    return $model if $model;
+    return $model if defined $model;
     return $c->comp("M::$name");
 }
 
-=item $c->view($name)
+=head2 $c->view($name)
 
 Gets a L<Catalyst::View> instance by name.
 
@@ -416,23 +431,19 @@ Gets a L<Catalyst::View> instance by name.
 sub view {
     my ( $c, $name ) = @_;
     my $view = $c->comp("View::$name");
-    return $view if $view;
+    return $view if defined $view;
     return $c->comp("V::$name");
 }
 
-=back
-
 =head2 Class data and helper classes
 
-=over 4
-
-=item $c->config
+=head2 $c->config
 
 Returns or takes a hashref containing the application's configuration.
 
     __PACKAGE__->config({ db => 'dsn:SQLite:foo.db' });
 
-=item $c->debug
+=head2 $c->debug
 
 Overload to enable debug messages (same as -Debug option).
 
@@ -440,36 +451,35 @@ Overload to enable debug messages (same as -Debug option).
 
 sub debug { 0 }
 
-=item $c->dispatcher
+=head2 $c->dispatcher
 
-Returns the dispatcher instance. Stringifies to class name.
+Returns the dispatcher instance. Stringifies to class name. See
+L<Catalyst::Dispatcher>.
 
-=item $c->engine
+=head2 $c->engine
 
-Returns the engine instance. Stringifies to the class name.
+Returns the engine instance. Stringifies to the class name. See
+L<Catalyst::Engine>.
 
-=item $c->log
+=head2 $c->log
 
-Returns the logging object instance. Unless it is already set, Catalyst sets this up with a
-L<Catalyst::Log> object. To use your own log class:
+Returns the logging object instance. Unless it is already set, Catalyst
+sets this up with a L<Catalyst::Log> object. To use your own log class:
 
     $c->log( MyLogger->new );
-    $c->log->info( 'now logging with my own logger!' );
+    $c->log->info( 'Now logging with my own logger!' );
 
-Your log class should implement the methods described in the L<Catalyst::Log>
-man page.
+Your log class should implement the methods described in the
+L<Catalyst::Log> man page.
 
 =cut
 
-=back
-
 =head2 Utility methods
 
-=over 4
+=head2 $c->path_to(@path)
 
-=item $c->path_to(@path)
-
-Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
+Merges C<@path> with C<$c-E<gt>config-E<gt>{home}> and returns a
+L<Path::Class> object.
 
 For example:
 
@@ -484,10 +494,10 @@ sub path_to {
     else { return file( $c->config->{home}, @path ) }
 }
 
-=item $c->plugin( $name, $class, @args )
+=head2 $c->plugin( $name, $class, @args )
 
-Helper method for plugins. It creates a classdata accessor/mutator and loads
-and instantiates the given class.
+Helper method for plugins. It creates a classdata accessor/mutator and
+loads and instantiates the given class.
 
     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 
@@ -519,12 +529,12 @@ sub plugin {
       if $class->debug;
 }
 
-=item MyApp->setup
+=head2 MyApp->setup
 
 Initializes the dispatcher and engine, loads any plugins, and loads the
-model, view, and controller components.  You may also specify an array of
-plugins to load here, if you choose to not load them in the C<use Catalyst>
-line.
+model, view, and controller components. You may also specify an array
+of plugins to load here, if you choose to not load them in the C<use
+Catalyst> line.
 
     MyApp->setup;
     MyApp->setup( qw/-Debug/ );
@@ -581,8 +591,11 @@ sub setup {
         <<"EOF") if ( $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
 You are running an old script!
 
-  Please update by running:
-    catalyst.pl -nonew -scripts $class
+  Please update by running (this will overwrite existing files):
+    catalyst.pl -force -scripts $class
+
+  or (this will not overwrite existing files):
+    catalyst.pl -scripts $class
 EOF
 
     if ( $class->debug ) {
@@ -591,7 +604,9 @@ EOF
 
         {
             no strict 'refs';
-            @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
+            @plugins =
+              map { $_ . ' ' . ( $_->VERSION || '' ) }
+              grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
         }
 
         if (@plugins) {
@@ -648,12 +663,12 @@ EOF
     $class->log->_flush() if $class->log->can('_flush');
 }
 
-=item $c->uri_for( $path, [ @args ] )
+=head2 $c->uri_for( $path, [ @args ] )
 
-Merges path with $c->request->base for absolute uri's and with
-$c->request->match for relative uri's, then returns a normalized
-L<URI> object. If any args are passed, they are added at the end
-of the path.
+Merges path with C<$c-E<gt>request-E<gt>base> for absolute uri's and
+with C<$c-E<gt>namespace> for relative uri's, then returns a
+normalized L<URI> object. If any args are passed, they are added at the
+end of the path.
 
 =cut
 
@@ -663,22 +678,25 @@ sub uri_for {
     my $basepath = $base->path;
     $basepath =~ s/\/$//;
     $basepath .= '/';
-    my $match = $c->request->match;
+    my $namespace = $c->namespace;
 
-    # massage match, empty if absolute path
-    $match =~ s/^\///;
-    $match .= '/' if $match;
+    # massage namespace, empty if absolute path
+    $namespace =~ s/^\///;
+    $namespace .= '/' if $namespace;
     $path ||= '';
-    $match = '' if $path =~ /^\//;
+    $namespace = '' if $path =~ /^\//;
     $path =~ s/^\///;
 
     # join args with '/', or a blank string
     my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
-    return URI->new_abs( URI->new_abs( "$path$args", "$basepath$match" ),
-        $base )->canonical;
+    $args =~ s/^\/// unless $path;
+    my $res =
+      URI->new_abs( URI->new_abs( "$path$args", "$basepath$namespace" ), $base )
+      ->canonical;
+    $res;
 }
 
-=item $c->welcome_message
+=head2 $c->welcome_message
 
 Returns the Catalyst welcome HTML page.
 
@@ -778,7 +796,7 @@ sub welcome_message {
                  <p>Welcome to the wonderful world of Catalyst.
                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
                     framework will make web development something you had
-                    never expected it to be: Fun, rewarding and quick.</p>
+                    never expected it to be: Fun, rewarding, and quick.</p>
                  <h2>What to do now?</h2>
                  <p>That really depends  on what <b>you</b> want to do.
                     We do, however, provide you with a few starting points.</p>
@@ -789,12 +807,12 @@ perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.po
                  <h2>What to do next?</h2>
                  <p>Next it's time to write an actual application. Use the
                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
-                    <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a> and
-                    <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>,
+                    <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
+                    <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
                     they can save you a lot of work.</p>
                     <pre><code>script/${prefix}_create.pl -help</code></pre>
                     <p>Also, be sure to check out the vast and growing
-                    collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&amp;mode=all">plugins for Catalyst on CPAN</a>,
+                    collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&amp;mode=all">plugins for Catalyst on CPAN</a>;
                     you are likely to find what you need there.
                     </p>
 
@@ -823,48 +841,28 @@ perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.po
 EOF
 }
 
-=back
-
 =head1 INTERNAL METHODS
 
-=over 4
-
-=item $c->benchmark( $coderef )
-
-Takes a coderef with arguments and returns elapsed time as float.
-
-    my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
-    $c->log->info( sprintf "Processing took %f seconds", $elapsed );
-
-=cut
-
-sub benchmark {
-    my $c       = shift;
-    my $code    = shift;
-    my $time    = [gettimeofday];
-    my @return  = &$code(@_);
-    my $elapsed = tv_interval $time;
-    return wantarray ? ( $elapsed, @return ) : $elapsed;
-}
+These methods are not meant to be used by end users.
 
-=item $c->components
+=head2 $c->components
 
 Returns a hash of components.
 
-=item $c->context_class
+=head2 $c->context_class
 
 Returns or sets the context class.
 
-=item $c->counter
+=head2 $c->counter
 
-Returns a hashref containing coderefs and execution counts (needed for deep
-recursion detection).
+Returns a hashref containing coderefs and execution counts (needed for
+deep recursion detection).
 
-=item $c->depth
+=head2 $c->depth
 
 Returns the number of actions on the current internal execution stack.
 
-=item $c->dispatch
+=head2 $c->dispatch
 
 Dispatches a request to actions.
 
@@ -872,14 +870,14 @@ Dispatches a request to actions.
 
 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
 
-=item $c->dispatcher_class
+=head2 $c->dispatcher_class
 
 Returns or sets the dispatcher class.
 
-=item $c->dump_these
+=head2 $c->dump_these
 
-Returns a list of 2-element array references (name, structure) pairs that will
-be dumped on the error page in debug mode.
+Returns a list of 2-element array references (name, structure) pairs
+that will be dumped on the error page in debug mode.
 
 =cut
 
@@ -888,11 +886,11 @@ sub dump_these {
     [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
 }
 
-=item $c->engine_class
+=head2 $c->engine_class
 
 Returns or sets the engine class.
 
-=item $c->execute( $class, $coderef )
+=head2 $c->execute( $class, $coderef )
 
 Execute a coderef in given class and catch exceptions. Errors are available
 via $c->error.
@@ -904,14 +902,8 @@ sub execute {
     $class = $c->components->{$class} || $class;
     $c->state(0);
 
-    my $callsub =
-        ( caller(0) )[0]->isa('Catalyst::Action')
-      ? ( caller(2) )[3]
-      : ( caller(1) )[3];
-
-    my $action = '';
     if ( $c->debug ) {
-        $action = "$code";
+        my $action = "$code";
         $action = "/$action" unless $action =~ /\-\>/;
         $c->counter->{"$code"}++;
 
@@ -923,34 +915,96 @@ sub execute {
             return $c->state;
         }
 
+        # determine if the call was the result of a forward
+        my $callsub_index = ( caller(0) )[0]->isa('Catalyst::Action') ? 2 : 1;
+        if ( ( caller($callsub_index) )[3] =~ /^NEXT/ ) {
+
+            # work around NEXT if execute was extended by a plugin
+            $callsub_index += 3;
+        }
+        my $callsub = ( caller($callsub_index) )[3];
+
         $action = "-> $action" if $callsub =~ /forward$/;
+
+        my $node = Tree::Simple->new(
+            {
+                action  => $action,
+                elapsed => undef,     # to be filled in later
+            }
+        );
+        $node->setUID( "$code" . $c->counter->{"$code"} );
+
+        unless ( ( $code->name =~ /^_.*/ )
+            && ( !$c->config->{show_internal_actions} ) )
+        {
+
+            # is this a root-level call or a forwarded call?
+            if ( $callsub =~ /forward$/ ) {
+
+                # forward, locate the caller
+                if ( my $parent = $c->stack->[-1] ) {
+                    my $visitor = Tree::Simple::Visitor::FindByUID->new;
+                    $visitor->searchForUID(
+                        "$parent" . $c->counter->{"$parent"} );
+                    $c->{stats}->accept($visitor);
+                    if ( my $result = $visitor->getResult ) {
+                        $result->addChild($node);
+                    }
+                }
+                else {
+
+                    # forward with no caller may come from a plugin
+                    $c->{stats}->addChild($node);
+                }
+            }
+            else {
+
+                # root-level call
+                $c->{stats}->addChild($node);
+            }
+        }
     }
+
     push( @{ $c->stack }, $code );
-    eval {
-        if ( $c->debug )
+    my $elapsed = 0;
+    my $start   = 0;
+    $start = [gettimeofday] if $c->debug;
+    eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
+    $elapsed = tv_interval($start) if $c->debug;
+
+    if ( $c->debug ) {
+        unless ( ( $code->name =~ /^_.*/ )
+            && ( !$c->config->{show_internal_actions} ) )
         {
-            my ( $elapsed, @state ) =
-              $c->benchmark( $code, $class, $c, @{ $c->req->args } );
-            unless ( ( $code->name =~ /^_.*/ )
-                && ( !$c->config->{show_internal_actions} ) )
-            {
-                push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
+
+            # FindByUID uses an internal die, so we save the existing error
+            my $error = $@;
+
+            # locate the node in the tree and update the elapsed time
+            my $visitor = Tree::Simple::Visitor::FindByUID->new;
+            $visitor->searchForUID( "$code" . $c->counter->{"$code"} );
+            $c->{stats}->accept($visitor);
+            if ( my $result = $visitor->getResult ) {
+                my $value = $result->getNodeValue;
+                $value->{elapsed} = sprintf( '%fs', $elapsed );
+                $result->setNodeValue($value);
             }
-            $c->state(@state);
-        }
-        else {
-            $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 );
+
+            # restore error
+            $@ = $error || undef;
         }
-    };
+    }
+    my $last = ${ $c->stack }[-1];
     pop( @{ $c->stack } );
 
     if ( my $error = $@ ) {
-
         if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
         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);
@@ -959,7 +1013,7 @@ sub execute {
     return $c->state;
 }
 
-=item $c->finalize
+=head2 $c->finalize
 
 Finalizes the request.
 
@@ -991,7 +1045,7 @@ sub finalize {
     return $c->response->status;
 }
 
-=item $c->finalize_body
+=head2 $c->finalize_body
 
 Finalizes body.
 
@@ -999,7 +1053,7 @@ Finalizes body.
 
 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
 
-=item $c->finalize_cookies
+=head2 $c->finalize_cookies
 
 Finalizes cookies.
 
@@ -1007,7 +1061,7 @@ Finalizes cookies.
 
 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
 
-=item $c->finalize_error
+=head2 $c->finalize_error
 
 Finalizes error.
 
@@ -1015,7 +1069,7 @@ Finalizes error.
 
 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
 
-=item $c->finalize_headers
+=head2 $c->finalize_headers
 
 Finalizes headers.
 
@@ -1035,7 +1089,19 @@ sub finalize_headers {
 
     # Content-Length
     if ( $c->response->body && !$c->response->content_length ) {
-        $c->response->content_length( bytes::length( $c->response->body ) );
+
+        # 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');
+            }
+        }
+        else {
+            $c->response->content_length( bytes::length( $c->response->body ) );
+        }
     }
 
     # Errors
@@ -1052,11 +1118,11 @@ sub finalize_headers {
     $c->response->{_finalized_headers} = 1;
 }
 
-=item $c->finalize_output
+=head2 $c->finalize_output
 
 An alias for finalize_body.
 
-=item $c->finalize_read
+=head2 $c->finalize_read
 
 Finalizes the input after reading is complete.
 
@@ -1064,15 +1130,15 @@ Finalizes the input after reading is complete.
 
 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
 
-=item $c->finalize_uploads
+=head2 $c->finalize_uploads
 
-Finalizes uploads.  Cleans up any temporary files.
+Finalizes uploads. Cleans up any temporary files.
 
 =cut
 
 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
 
-=item $c->get_action( $action, $namespace )
+=head2 $c->get_action( $action, $namespace )
 
 Gets an action in a given namespace.
 
@@ -1080,15 +1146,16 @@ Gets an action in a given namespace.
 
 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
 
-=item $c->get_actions( $action, $namespace )
+=head2 $c->get_actions( $action, $namespace )
 
-Gets all actions of a given name in a namespace and all parent namespaces.
+Gets all actions of a given name in a namespace and all parent
+namespaces.
 
 =cut
 
 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
 
-=item handle_request( $class, @arguments )
+=head2 handle_request( $class, @arguments )
 
 Called to handle each HTTP request.
 
@@ -1100,24 +1167,33 @@ sub handle_request {
     # Always expect worst case!
     my $status = -1;
     eval {
-        my @stats = ();
+        my $stats = ( $class->debug ) ? Tree::Simple->new: q{};
 
         my $handler = sub {
             my $c = $class->prepare(@arguments);
-            $c->{stats} = \@stats;
+            $c->{stats} = $stats;
             $c->dispatch;
             return $c->finalize;
         };
 
         if ( $class->debug ) {
-            my $elapsed;
-            ( $elapsed, $status ) = $class->benchmark($handler);
+            my $start = [gettimeofday];
+            $status = &$handler;
+            my $elapsed = tv_interval $start;
             $elapsed = sprintf '%f', $elapsed;
             my $av = sprintf '%.3f',
               ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
             my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
 
-            for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
+            $stats->traverse(
+                sub {
+                    my $action = shift;
+                    my $stat   = $action->getNodeValue;
+                    $t->row( ( q{ } x $action->getDepth ) . $stat->{action},
+                        $stat->{elapsed} || '??' );
+                }
+            );
+
             $class->log->info(
                 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
         }
@@ -1135,10 +1211,10 @@ sub handle_request {
     return $status;
 }
 
-=item $c->prepare( @arguments )
+=head2 $c->prepare( @arguments )
 
-Creates a Catalyst context from an engine-specific request
-(Apache, CGI, etc.).
+Creates a Catalyst context from an engine-specific request (Apache, CGI,
+etc.).
 
 =cut
 
@@ -1213,7 +1289,7 @@ sub prepare {
     return $c;
 }
 
-=item $c->prepare_action
+=head2 $c->prepare_action
 
 Prepares action.
 
@@ -1221,7 +1297,7 @@ Prepares action.
 
 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
 
-=item $c->prepare_body
+=head2 $c->prepare_body
 
 Prepares message body.
 
@@ -1250,7 +1326,7 @@ sub prepare_body {
     }
 }
 
-=item $c->prepare_body_chunk( $chunk )
+=head2 $c->prepare_body_chunk( $chunk )
 
 Prepares a chunk of data before sending it to L<HTTP::Body>.
 
@@ -1261,7 +1337,7 @@ sub prepare_body_chunk {
     $c->engine->prepare_body_chunk( $c, @_ );
 }
 
-=item $c->prepare_body_parameters
+=head2 $c->prepare_body_parameters
 
 Prepares body parameters.
 
@@ -1272,7 +1348,7 @@ sub prepare_body_parameters {
     $c->engine->prepare_body_parameters( $c, @_ );
 }
 
-=item $c->prepare_connection
+=head2 $c->prepare_connection
 
 Prepares connection.
 
@@ -1283,7 +1359,7 @@ sub prepare_connection {
     $c->engine->prepare_connection( $c, @_ );
 }
 
-=item $c->prepare_cookies
+=head2 $c->prepare_cookies
 
 Prepares cookies.
 
@@ -1291,7 +1367,7 @@ Prepares cookies.
 
 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
 
-=item $c->prepare_headers
+=head2 $c->prepare_headers
 
 Prepares headers.
 
@@ -1299,7 +1375,7 @@ Prepares headers.
 
 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
 
-=item $c->prepare_parameters
+=head2 $c->prepare_parameters
 
 Prepares parameters.
 
@@ -1311,7 +1387,7 @@ sub prepare_parameters {
     $c->engine->prepare_parameters( $c, @_ );
 }
 
-=item $c->prepare_path
+=head2 $c->prepare_path
 
 Prepares path and base.
 
@@ -1319,7 +1395,7 @@ Prepares path and base.
 
 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
 
-=item $c->prepare_query_parameters
+=head2 $c->prepare_query_parameters
 
 Prepares query parameters.
 
@@ -1342,7 +1418,7 @@ sub prepare_query_parameters {
     }
 }
 
-=item $c->prepare_read
+=head2 $c->prepare_read
 
 Prepares the input for reading.
 
@@ -1350,7 +1426,7 @@ Prepares the input for reading.
 
 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
 
-=item $c->prepare_request
+=head2 $c->prepare_request
 
 Prepares the engine request.
 
@@ -1358,7 +1434,7 @@ Prepares the engine request.
 
 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
 
-=item $c->prepare_uploads
+=head2 $c->prepare_uploads
 
 Prepares uploads.
 
@@ -1386,7 +1462,7 @@ sub prepare_uploads {
     }
 }
 
-=item $c->prepare_write
+=head2 $c->prepare_write
 
 Prepares the output for writing.
 
@@ -1394,27 +1470,28 @@ Prepares the output for writing.
 
 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
 
-=item $c->request_class
+=head2 $c->request_class
 
 Returns or sets the request class.
 
-=item $c->response_class
+=head2 $c->response_class
 
 Returns or sets the response class.
 
-=item $c->read( [$maxlength] )
+=head2 $c->read( [$maxlength] )
 
-Reads a chunk of data from the request body.  This method is designed to be
-used in a while loop, reading $maxlength bytes on every call.  $maxlength
-defaults to the size of the request if not specified.
+Reads a chunk of data from the request body. This method is designed to
+be used in a while loop, reading C<$maxlength> bytes on every call.
+C<$maxlength> defaults to the size of the request if not specified.
 
-You have to set MyApp->config->{parse_on_demand} to use this directly.
+You have to set C<MyApp-E<gt>config-E<gt>{parse_on_demand}> to use this
+directly.
 
 =cut
 
 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
 
-=item $c->run
+=head2 $c->run
 
 Starts the engine.
 
@@ -1422,7 +1499,7 @@ Starts the engine.
 
 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
 
-=item $c->set_action( $action, $code, $namespace, $attrs )
+=head2 $c->set_action( $action, $code, $namespace, $attrs )
 
 Sets an action in a given namespace.
 
@@ -1430,7 +1507,7 @@ Sets an action in a given namespace.
 
 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
 
-=item $c->setup_actions($component)
+=head2 $c->setup_actions($component)
 
 Sets up actions for a component.
 
@@ -1438,7 +1515,7 @@ Sets up actions for a component.
 
 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
 
-=item $c->setup_components
+=head2 $c->setup_components
 
 Sets up components.
 
@@ -1459,7 +1536,7 @@ sub setup_components {
 
         my $instance;
 
-        eval { $instance = $component->new( $context, $config ); };
+        eval { $instance = $component->COMPONENT( $context, $config ); };
 
         if ( my $error = $@ ) {
 
@@ -1476,8 +1553,7 @@ qq/Couldn't instantiate component "$component", "new() didn't return a object"/
         return $instance;
     };
 
-    eval {
-        Module::Pluggable::Fast->import(
+    eval "package $class;\n" . q!Module::Pluggable::Fast->import(
             name   => '_catalyst_components',
             search => [
                 "$class\::Controller", "$class\::C",
@@ -1486,7 +1562,7 @@ qq/Couldn't instantiate component "$component", "new() didn't return a object"/
             ],
             callback => $callback
         );
-    };
+    !;
 
     if ( my $error = $@ ) {
 
@@ -1501,7 +1577,9 @@ qq/Couldn't instantiate component "$component", "new() didn't return a object"/
     }
 }
 
-=item $c->setup_dispatcher
+=head2 $c->setup_dispatcher
+
+Sets up dispatcher.
 
 =cut
 
@@ -1536,7 +1614,9 @@ sub setup_dispatcher {
     $class->dispatcher( $dispatcher->new );
 }
 
-=item $c->setup_engine
+=head2 $c->setup_engine
+
+Sets up engine.
 
 =cut
 
@@ -1555,7 +1635,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 +1651,25 @@ sub setup_engine {
 
         if ( $software eq 'mod_perl' ) {
 
-            if ( $version >= 1.99922 ) {
-                $engine = 'Catalyst::Engine::Apache2::MP20';
-            }
+            if ( !$engine ) {
 
-            elsif ( $version >= 1.9901 ) {
-                $engine = 'Catalyst::Engine::Apache2::MP19';
-            }
+                if ( $version >= 1.99922 ) {
+                    $engine = 'Catalyst::Engine::Apache2::MP20';
+                }
 
-            elsif ( $version >= 1.24 ) {
-                $engine = 'Catalyst::Engine::Apache::MP13';
-            }
+                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
@@ -1658,7 +1742,9 @@ qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
     $class->engine( $engine->new );
 }
 
-=item $c->setup_home
+=head2 $c->setup_home
+
+Sets up the home directory.
 
 =cut
 
@@ -1683,7 +1769,9 @@ sub setup_home {
     }
 }
 
-=item $c->setup_log
+=head2 $c->setup_log
+
+Sets up log.
 
 =cut
 
@@ -1708,7 +1796,9 @@ sub setup_log {
     }
 }
 
-=item $c->setup_plugins
+=head2 $c->setup_plugins
+
+Sets up plugins.
 
 =cut
 
@@ -1734,15 +1824,15 @@ sub setup_plugins {
     }
 }
 
-=item $c->stack
+=head2 $c->stack
 
 Returns the stack.
 
-=item $c->write( $data )
+=head2 $c->write( $data )
 
-Writes $data to the output stream.  When using this method directly, you will
-need to manually set the Content-Length header to the length of your output
-data, if known.
+Writes $data to the output stream. When using this method directly, you
+will need to manually set the C<Content-Length> header to the length of
+your output data, if known.
 
 =cut
 
@@ -1755,21 +1845,19 @@ sub write {
     return $c->engine->write( $c, @_ );
 }
 
-=item version
+=head2 version
 
-Returns the Catalyst version number. Mostly useful for "powered by" messages
-in template systems.
+Returns the Catalyst version number. Mostly useful for "powered by"
+messages in template systems.
 
 =cut
 
 sub version { return $Catalyst::VERSION }
 
-=back
-
 =head1 INTERNAL ACTIONS
 
-Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
-C<_ACTION> and C<_END>. These are by default not shown in the private
+Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
+C<_ACTION>, and C<_END>. These are by default not shown in the private
 action table, but you can make them visible with a config parameter.
 
     MyApp->config->{show_internal_actions} = 1;
@@ -1777,7 +1865,7 @@ action table, but you can make them visible with a config parameter.
 =head1 CASE SENSITIVITY
 
 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
-mapped to C</foo/bar>. You can activate case sensitivity with a config 
+mapped to C</foo/bar>. You can activate case sensitivity with a config
 parameter.
 
     MyApp->config->{case_sensitive} = 1;
@@ -1794,28 +1882,29 @@ you can enable on-demand parsing with a config parameter.
     
 =head1 PROXY SUPPORT
 
-Many production servers operate using the common double-server approach, with
-a lightweight frontend web server passing requests to a larger backend
-server.  An application running on the backend server must deal with two
-problems: the remote user always appears to be C<127.0.0.1> and the server's
-hostname will appear to be C<localhost> regardless of the virtual host that
-the user connected through.
+Many production servers operate using the common double-server approach,
+with a lightweight frontend web server passing requests to a larger
+backend server. An application running on the backend server must deal
+with two problems: the remote user always appears to be C<127.0.0.1> and
+the server's hostname will appear to be C<localhost> regardless of the
+virtual host that the user connected through.
 
-Catalyst will automatically detect this situation when you are running the
-frontend and backend servers on the same machine. The following changes
-are made to the request.
+Catalyst will automatically detect this situation when you are running
+the frontend and backend servers on the same machine. The following
+changes are made to the request.
 
-    $c->req->address is set to the user's real IP address, as read from the
-    HTTP X-Forwarded-For header.
+    $c->req->address is set to the user's real IP address, as read from 
+    the HTTP X-Forwarded-For header.
     
-    The host value for $c->req->base and $c->req->uri is set to the real host,
-    as read from the HTTP X-Forwarded-Host header.
+    The host value for $c->req->base and $c->req->uri is set to the real
+    host, as read from the HTTP X-Forwarded-Host header.
 
 Obviously, your web server must support these headers for this to work.
 
-In a more complex server farm environment where you may have your frontend
-proxy server(s) on different machines, you will need to set a configuration
-option to tell Catalyst to read the proxied data from the headers.
+In a more complex server farm environment where you may have your
+frontend proxy server(s) on different machines, you will need to set a
+configuration option to tell Catalyst to read the proxied data from the
+headers.
 
     MyApp->config->{using_frontend_proxy} = 1;
     
@@ -1854,23 +1943,21 @@ Wiki:
 
 =head1 SEE ALSO
 
-=over 4
+=head2 L<Task::Catalyst> - All you need to start with Catalyst
 
-=item L<Catalyst::Manual> - The Catalyst Manual
+=head2 L<Catalyst::Manual> - The Catalyst Manual
 
-=item L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
+=head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
 
-=item L<Catalyst::Engine> - Core Engine
+=head2 L<Catalyst::Engine> - Core engine
 
-=item L<Catalyst::Log> - The Log Class.
+=head2 L<Catalyst::Log> - Log class.
 
-=item L<Catalyst::Request> - The Request Object
+=head2 L<Catalyst::Request> - Request object
 
-=item L<Catalyst::Response> - The Response Object
+=head2 L<Catalyst::Response> - Response object
 
-=item L<Catalyst::Test> - The test suite.
-
-=back
+=head2 L<Catalyst::Test> - The test suite.
 
 =head1 CREDITS
 
@@ -1904,6 +1991,8 @@ David Kamholz
 
 David Naughton
 
+Drew Taylor
+
 Gary Ashton Jones
 
 Geoff Richards