Fix "direction" of relation required by role_rel in myapp.yml
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index 0403b00..b3cf87b 100644 (file)
@@ -59,7 +59,9 @@ __PACKAGE__->engine_class('Catalyst::Engine::CGI');
 __PACKAGE__->request_class('Catalyst::Request');
 __PACKAGE__->response_class('Catalyst::Response');
 
-our $VERSION = '5.6902';
+# Remember to update this in Catalyst::Runtime as well!
+
+our $VERSION = '5.70_03';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -790,15 +792,7 @@ EOF
     }
     
     if ( $class->debug ) {
-
-        my @plugins = ();
-
-        {
-            no strict 'refs';
-            @plugins =
-              map { $_ . ' ' . ( $_->VERSION || '' ) }
-              grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
-        }
+        my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
 
         if (@plugins) {
             my $t = Text::SimpleTable->new(74);
@@ -898,12 +892,12 @@ sub uri_for {
     my $params =
       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
 
-    for my $value ( values %$params ) {\r
-        my $isa_ref = ref $value;\r
-        if( $isa_ref and $isa_ref ne 'ARRAY' ) {\r
-            croak( "Non-array reference ($isa_ref) passed to uri_for()" );\r
-        }\r
-        utf8::encode( $_ ) for grep { defined } $isa_ref ? @$value : $value;\r
+    for my $value ( values %$params ) {
+        my $isa_ref = ref $value;
+        if( $isa_ref and $isa_ref ne 'ARRAY' ) {
+            croak( "Non-array reference ($isa_ref) passed to uri_for()" );
+        }
+        utf8::encode( $_ ) for grep { defined } $isa_ref ? @$value : $value;
     };
     
     # join args with '/', or a blank string
@@ -1134,16 +1128,15 @@ sub execute {
         return $c->state;
     }
 
-    my $stats_info = $c->_stats_start_execute( $code );
+    my $stats_info = $c->_stats_start_execute( $code ) if $c->debug;
 
     push( @{ $c->stack }, $code );
     
     eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
 
-    $c->_stats_finish_execute( $stats_info );
+    $c->_stats_finish_execute( $stats_info ) if $c->debug and $stats_info;
     
-    my $last = ${ $c->stack }[-1];
-    pop( @{ $c->stack } );
+    my $last = pop( @{ $c->stack } );
 
     if ( my $error = $@ ) {
         if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
@@ -1164,13 +1157,14 @@ sub execute {
 sub _stats_start_execute {
     my ( $c, $code ) = @_;
 
-    return unless $c->debug;
+    return if ( ( $code->name =~ /^_.*/ )
+        && ( !$c->config->{show_internal_actions} ) );
 
-    my $action = "$code";
-
-    $action = "/$action" unless $action =~ /\-\>/;
     $c->counter->{"$code"}++;
 
+    my $action = "$code";
+    $action = "/$action" unless $action =~ /->/;
+
     # determine if the call was the result of a forward
     # this is done by walking up the call stack and looking for a calling
     # sub of Catalyst::forward before the eval
@@ -1196,73 +1190,42 @@ sub _stats_start_execute {
     );
     $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);
+    # 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 {
 
-            # root-level call
+            # forward with no caller may come from a plugin
             $c->stats->addChild($node);
         }
     }
+    else {
 
-    my $start = [gettimeofday];
-    my $elapsed = tv_interval($start);
+        # root-level call
+        $c->stats->addChild($node);
+    }
 
     return {
-        code    => $code,
-        elapsed => $elapsed,
-        start   => $start,
+        start   => [gettimeofday],
         node    => $node,
-      }
+    };
 }
 
 sub _stats_finish_execute {
     my ( $c, $info ) = @_;
-
-    return unless $c->debug;
-
-    my ( $code, $start, $elapsed ) = @{ $info }{qw/code start elapsed/};
-
-    unless ( ( $code->name =~ /^_.*/ )
-        && ( !$c->config->{show_internal_actions} ) )
-    {
-
-        # 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);
-        }
-
-        # restore error
-        $@ = $error || undef;
-    }
+    my $elapsed = tv_interval $info->{start};
+    my $value = $info->{node}->getNodeValue;
+    $value->{elapsed} = sprintf( '%fs', $elapsed );
 }
 
 =head2 $c->_localize_fields( sub { }, \%keys );
@@ -1444,25 +1407,20 @@ sub handle_request {
     # Always expect worst case!
     my $status = -1;
     eval {
-        my $stats = ( $class->debug ) ? Tree::Simple->new: q{};
-
-        my $handler = sub {
+        if ($class->debug) {
+            my $start = [gettimeofday];
             my $c = $class->prepare(@arguments);
-            $c->stats($stats);
+            $c->stats(Tree::Simple->new);          
             $c->dispatch;
-            return $c->finalize;
-        };
+            $status = $c->finalize;            
 
-        if ( $class->debug ) {
-            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( [ 62, 'Action' ], [ 9, 'Time' ] );
 
-            $stats->traverse(
+            $c->stats->traverse(
                 sub {
                     my $action = shift;
                     my $stat   = $action->getNodeValue;
@@ -1474,8 +1432,11 @@ sub handle_request {
             $class->log->info(
                 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
         }
-        else { $status = &$handler }
-
+        else {
+            my $c = $class->prepare(@arguments);
+            $c->dispatch;
+            $status = $c->finalize;            
+        }
     };
 
     if ( my $error = $@ ) {
@@ -1801,23 +1762,29 @@ sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
 
 =head2 $c->setup_components
 
-Sets up components.
+Sets up components. Specify a C<setup_components> config option to pass additional options
+directly to L<Module::Pluggable>. To add additional search paths, specify a key named
+C<search_extra> as an array reference. Items in the array beginning with C<::> will have the
+application class name prepended to them.
 
 =cut
 
 sub setup_components {
     my $class = shift;
 
+    my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
+    my $config  = $class->config->{ setup_components };
+    my $extra   = delete $config->{ search_extra } || [];
+    
+    push @paths, @$extra;
+        
     my $locator = Module::Pluggable::Object->new(
-        search_path => [
-            "${class}::Controller", "${class}::C",
-            "${class}::Model",      "${class}::M",
-            "${class}::View",       "${class}::V"
-        ],
+        search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
+        %$config
     );
     
     for my $component ( sort { length $a <=> length $b } $locator->plugins ) {
-        require Class::Inspector->filename($component);
+        Catalyst::Utils::ensure_class_loaded( $component );
 
         my $module  = $class->setup_component( $component );
         my %modules = (