X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=b43ffcc89a825be4f26e4f6180d443d1ae269fe3;hp=554e959fa737339e2347d7ddbfe9f645ec8b1559;hb=50f6a990e35f22a9037b1caf72bb8271bb556e78;hpb=73664287069fe2e0c731df29f80b5c19838c60d2

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 554e959..b43ffcc 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -22,9 +22,11 @@ use Scalar::Util qw/weaken blessed/;
 use Tree::Simple qw/use_weak_refs/;
 use Tree::Simple::Visitor::FindByUID;
 use attributes;
+use utf8;
+use Carp qw/croak/;
 
 __PACKAGE__->mk_accessors(
-    qw/counter request response state action stack namespace/
+    qw/counter request response state action stack namespace stats/
 );
 
 attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
@@ -59,7 +61,7 @@ __PACKAGE__->engine_class('Catalyst::Engine::CGI');
 __PACKAGE__->request_class('Catalyst::Request');
 __PACKAGE__->response_class('Catalyst::Response');
 
-our $VERSION = '5.66';
+our $VERSION = '5.6902';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -85,7 +87,7 @@ Catalyst - The Elegant MVC Web Application Framework
 
 =head1 SYNOPSIS
 
-    # use the helper to start a new application
+    # use the helper to create a new application
     catalyst.pl MyApp
 
     # add models, views, controllers
@@ -99,15 +101,16 @@ Catalyst - The Elegant MVC Web Application Framework
     # command line testing interface
     script/myapp_test.pl /yada
 
-    ### in MyApp.pm
+    ### in lib/MyApp.pm
     use Catalyst qw/-Debug/; # include plugins here as well
     
+	### In libMyApp/Controller/Root.pm (autocreated)
     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
         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( { country => $args[0] } );
+          $c->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            
@@ -125,7 +128,7 @@ Catalyst - The Elegant MVC Web Application Framework
     # called for all actions, from the top-most controller downwards
     sub auto : Private { 
         my ( $self, $c ) = @_;
-        if ( !$c->user ) {
+        if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
             $c->res->redirect( '/login' ); # require login
             return 0; # abort request and go immediately to end()
         }
@@ -154,7 +157,7 @@ Catalyst - The Elegant MVC Web Application Framework
     # called for /foo/bar/baz
     sub baz : Local { ... }
     
-    # first MyApp auto is called, then Foo auto, then this
+    # first Root auto is called, then Foo auto, then this
     sub auto : Private { ... }
     
     # powerful regular expression paths are also possible
@@ -168,7 +171,7 @@ See L<Catalyst::Manual::Intro> for additional information.
 
 =head1 DESCRIPTION
 
-The key concept of Catalyst is DRY (Don't Repeat Yourself).
+Catalyst is a modern framework for making web applications without the pain usually associated with this process. This document is a reference to the main Catalyst application. If you are a new user, we suggest you start with L<Catalyst::Manual::Tutorial> or  L<Catalyst::Manual::Intro>
 
 See L<Catalyst::Manual> for more documentation.
 
@@ -242,16 +245,16 @@ corresponding to the controller of the current action. For example:
 Returns the current L<Catalyst::Request> object. See
 L<Catalyst::Request>.
 
-=head2 PROCESSING AND RESPONSE TO THE CURRENT REQUEST
+=head2 REQUEST FLOW HANDLING
 
 =head2 $c->forward( $action [, \@arguments ] )
 
 =head2 $c->forward( $class, $method, [, \@arguments ] )
 
-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,
+Forwards processing to another action, by it's private name. 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.
 
 Any data C<return>ed from the action forwarded to, will be returned by the
@@ -262,6 +265,18 @@ call to forward.
     $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
     $c->forward('MyApp::View::TT');
 
+Note that forward implies an C<<eval { }>> around the call (well, actually
+C<execute> does), thus de-fatalizing all 'dies' within the called action. If
+you want C<die> to propagate you need to do something like:
+
+    $c->forward('foo');
+    die $c->error if $c->error;
+
+Or make sure to always return true values from your actions and write your code
+like this:
+
+    $c->forward('foo') || return;
+
 =cut
 
 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
@@ -270,12 +285,47 @@ sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
 
 =head2 $c->detach( $class, $method, [, \@arguments ] )
 
-The same as C<forward>, but doesn't return.
+The same as C<forward>, but doesn't return to the previous action when 
+processing is finished. 
 
 =cut
 
 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 
+=head2 $c->response
+
+=head2 $c->res
+
+Returns the current L<Catalyst::Response> object.
+
+=head2 $c->stash
+
+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 } );
+    $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
+    
+    # stash is automatically passed to the view for use in a template
+    $c->forward( 'MyApp::V::TT' );
+
+=cut
+
+sub stash {
+    my $c = shift;
+    if (@_) {
+        my $stash = @_ > 1 ? {@_} : $_[0];
+        while ( my ( $key, $val ) = each %$stash ) {
+            $c->{stash}->{$key} = $val;
+        }
+    }
+    return $c->{stash};
+}
+
 =head2 $c->error
 
 =head2 $c->error($error, ...)
@@ -298,12 +348,18 @@ sub error {
     my $c = shift;
     if ( $_[0] ) {
         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
+        croak @$error unless ref $c;
         push @{ $c->{error} }, @$error;
     }
     elsif ( defined $_[0] ) { $c->{error} = undef }
     return $c->{error} || [];
 }
 
+
+=head2 $c->state
+
+Contains the return value of the last executed action.
+
 =head2 $c->clear_errors
 
 Clear errors.  You probably don't want to clear the errors unless you are
@@ -320,45 +376,8 @@ sub clear_errors {
     $c->error(0);
 }
 
-=head2 $c->response
-
-=head2 $c->res
-
-Returns the current L<Catalyst::Response> object.
-
-=head2 $c->stash
-
-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 } );
-    $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
-    
-    # stash is automatically passed to the view for use in a template
-    $c->forward( 'MyApp::V::TT' );
 
-=cut
 
-sub stash {
-    my $c = shift;
-    if (@_) {
-        my $stash = @_ > 1 ? {@_} : $_[0];
-        while ( my ( $key, $val ) = each %$stash ) {
-            $c->{stash}->{$key} = $val;
-        }
-    }
-    return $c->{stash};
-}
-
-=head2 $c->state
-
-Contains the return value of the last executed action.
-
-=cut
 
 # search via regex
 sub _comp_search {
@@ -399,6 +418,29 @@ sub _comp_prefixes {
     return $comp;
 }
 
+# Find possible names for a prefix 
+
+sub _comp_names {
+    my ( $c, @prefixes ) = @_;
+
+    my $appclass = ref $c || $c;
+
+    my @pre = map { "${appclass}::${_}::" } @prefixes;
+
+    my @names;
+
+    COMPONENT: foreach my $comp ($c->component) {
+        foreach my $p (@pre) {
+            if ($comp =~ s/^$p//) {
+                push(@names, $comp);
+                next COMPONENT;
+            }
+        }
+    }
+
+    return @names;
+}
+
 # Return a component if only one matches.
 sub _comp_singular {
     my ( $c, @prefixes ) = @_;
@@ -421,42 +463,6 @@ sub _filter_component {
 
 =head2 COMPONENT ACCESSORS
 
-=head2 $c->comp($name)
-
-=head2 $c->component($name)
-
-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
-
-sub component {
-    my $c = shift;
-
-    if (@_) {
-
-        my $name = shift;
-
-        my $appclass = ref $c || $c;
-
-        my @names = (
-            $name, "${appclass}::${name}",
-            map { "${appclass}::${_}::${name}" }
-              qw/Model M Controller C View V/
-        );
-
-        my $comp = $c->_comp_explicit(@names);
-        return $c->_filter_component( $comp, @_ ) if defined($comp);
-
-        $comp = $c->_comp_search($name);
-        return $c->_filter_component( $comp, @_ ) if defined($comp);
-    }
-
-    return sort keys %{ $c->components };
-}
-
 =head2 $c->controller($name)
 
 Gets a L<Catalyst::Controller> instance by name.
@@ -497,6 +503,18 @@ sub model {
 
 }
 
+=head2 $c->controllers
+
+Returns the available names which can be passed to $c->controller
+
+=cut
+
+sub controllers {
+    my ( $c ) = @_;
+    return $c->_comp_names(qw/Controller C/);
+}
+
+
 =head2 $c->view($name)
 
 Gets a L<Catalyst::View> instance by name.
@@ -518,7 +536,68 @@ sub view {
     return $c->_filter_component( $c->_comp_singular(qw/View V/) );
 }
 
-=head2 Class data and helper classes
+=head2 $c->models
+
+Returns the available names which can be passed to $c->model
+
+=cut
+
+sub models {
+    my ( $c ) = @_;
+    return $c->_comp_names(qw/Model M/);
+}
+
+
+=head2 $c->views
+
+Returns the available names which can be passed to $c->view
+
+=cut
+
+sub views {
+    my ( $c ) = @_;
+    return $c->_comp_names(qw/View V/);
+}
+
+=head2 $c->comp($name)
+
+=head2 $c->component($name)
+
+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
+
+sub component {
+    my $c = shift;
+
+    if (@_) {
+
+        my $name = shift;
+
+        my $appclass = ref $c || $c;
+
+        my @names = (
+            $name, "${appclass}::${name}",
+            map { "${appclass}::${_}::${name}" }
+              qw/Model M Controller C View V/
+        );
+
+        my $comp = $c->_comp_explicit(@names);
+        return $c->_filter_component( $comp, @_ ) if defined($comp);
+
+        $comp = $c->_comp_search($name);
+        return $c->_filter_component( $comp, @_ ) if defined($comp);
+    }
+
+    return sort keys %{ $c->components };
+}
+
+
+
+=head2 CLASS DATA AND HELPER CLASSES
 
 =head2 $c->config
 
@@ -532,6 +611,7 @@ applications home directory.
     ---
     db: dsn:SQLite:foo.db
 
+
 =cut
 
 sub config {
@@ -543,24 +623,6 @@ sub config {
     $c->NEXT::config(@_);
 }
 
-=head2 $c->debug
-
-Overload to enable debug messages (same as -Debug option).
-
-=cut
-
-sub debug { 0 }
-
-=head2 $c->dispatcher
-
-Returns the dispatcher instance. Stringifies to class name. See
-L<Catalyst::Dispatcher>.
-
-=head2 $c->engine
-
-Returns the engine instance. Stringifies to the class name. See
-L<Catalyst::Engine>.
-
 =head2 $c->log
 
 Returns the logging object instance. Unless it is already set, Catalyst sets
@@ -578,8 +640,26 @@ And later:
 Your log class should implement the methods described in the
 L<Catalyst::Log> man page.
 
+
+=head2 $c->debug
+
+Overload to enable debug messages (same as -Debug option).
+
 =cut
 
+sub debug { 0 }
+
+=head2 $c->dispatcher
+
+Returns the dispatcher instance. Stringifies to class name. See
+L<Catalyst::Dispatcher>.
+
+=head2 $c->engine
+
+Returns the engine instance. Stringifies to the class name. See
+L<Catalyst::Engine>.
+
+
 =head2 UTILITY METHODS
 
 =head2 $c->path_to(@path)
@@ -796,6 +876,14 @@ sub uri_for {
     my $params =
       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
 
+    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
     my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
     $args =~ s/^\/// unless $path;
@@ -994,7 +1082,10 @@ that will be dumped on the error page in debug mode.
 
 sub dump_these {
     my $c = shift;
-    [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
+    [ Request => $c->req ], 
+    [ Response => $c->res ], 
+    [ Stash => $c->stash ],
+    [ Config => $c->config ];
 }
 
 =head2 $c->engine_class
@@ -1023,95 +1114,14 @@ sub execute {
         return $c->state;
     }
 
-    if ( $c->debug ) {
-        my $action = "$code";
-        $action = "/$action" unless $action =~ /\-\>/;
-        $c->counter->{"$code"}++;
-
-        # 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
-        my $callsub = q{};
-        for my $index ( 1 .. 10 ) {
-            last
-              if ( ( caller($index) )[0] eq 'Catalyst'
-                && ( caller($index) )[3] eq '(eval)' );
-
-            if ( ( caller($index) )[3] =~ /forward$/ ) {
-                $callsub = ( caller($index) )[3];
-                $action  = "-> $action";
-                last;
-            }
-        }
-
-        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);
-            }
-        }
-    }
+    my $stats_info = $c->_stats_start_execute( $code );
 
     push( @{ $c->stack }, $code );
-    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} ) )
-        {
 
-            # 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;
-        }
-    }
+    $c->_stats_finish_execute( $stats_info );
+    
     my $last = ${ $c->stack }[-1];
     pop( @{ $c->stack } );
 
@@ -1131,6 +1141,127 @@ sub execute {
     return $c->state;
 }
 
+sub _stats_start_execute {
+    my ( $c, $code ) = @_;
+
+    return unless $c->debug;
+
+    my $action = "$code";
+
+    $action = "/$action" unless $action =~ /\-\>/;
+    $c->counter->{"$code"}++;
+
+    # 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
+    my $callsub = q{};
+    for my $index ( 2 .. 11 ) {
+        last
+        if ( ( caller($index) )[0] eq 'Catalyst'
+            && ( caller($index) )[3] eq '(eval)' );
+
+        if ( ( caller($index) )[3] =~ /forward$/ ) {
+            $callsub = ( caller($index) )[3];
+            $action  = "-> $action";
+            last;
+        }
+    }
+
+    my $node = Tree::Simple->new(
+        {
+            action  => $action,
+            elapsed => undef,     # to be filled in later
+            comment => "",
+        }
+    );
+    $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);
+        }
+    }
+
+    my $start = [gettimeofday];
+    my $elapsed = tv_interval($start);
+
+    return {
+        code    => $code,
+        elapsed => $elapsed,
+        start   => $start,
+        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;
+    }
+}
+
+=head2 $c->_localize_fields( sub { }, \%keys );
+
+=cut
+
+sub _localize_fields {
+    my ( $c, $localized, $code ) = ( @_ );
+
+    my $request = delete $localized->{request} || {};
+    my $response = delete $localized->{response} || {};
+    
+    local @{ $c }{ keys %$localized } = values %$localized;
+    local @{ $c->request }{ keys %$request } = values %$request;
+    local @{ $c->response }{ keys %$response } = values %$response;
+
+    $code->();
+}
+
 =head2 $c->finalize
 
 Finalizes the request.
@@ -1297,7 +1428,7 @@ sub handle_request {
 
         my $handler = sub {
             my $c = $class->prepare(@arguments);
-            $c->{stats} = $stats;
+            $c->stats($stats);
             $c->dispatch;
             return $c->finalize;
         };
@@ -1315,7 +1446,7 @@ sub handle_request {
                 sub {
                     my $action = shift;
                     my $stat   = $action->getNodeValue;
-                    $t->row( ( q{ } x $action->getDepth ) . $stat->{action},
+                    $t->row( ( q{ } x $action->getDepth ) . $stat->{action} . $stat->{comment},
                         $stat->{elapsed} || '??' );
                 }
             );
@@ -1423,7 +1554,7 @@ sub prepare {
 
 =head2 $c->prepare_action
 
-Prepares action.
+Prepares action. See L<Catalyst::Dispatcher>.
 
 =cut
 
@@ -1462,6 +1593,8 @@ sub prepare_body {
 
 Prepares a chunk of data before sending it to L<HTTP::Body>.
 
+See L<Catalyst::Engine>.
+
 =cut
 
 sub prepare_body_chunk {