From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 1 Nov 2005 01:29:47 +0000 (+0000)
Subject: - Added new _DISPATCH private action for dispatching
X-Git-Tag: 5.7099_04~1072
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=ba599d1c7a0c3219cd3825264c44d22362ed179a

- Added new _DISPATCH private action for dispatching
---

diff --git a/lib/Catalyst/AttrContainer.pm b/lib/Catalyst/AttrContainer.pm
new file mode 100644
index 0000000..c7eb129
--- /dev/null
+++ b/lib/Catalyst/AttrContainer.pm
@@ -0,0 +1,57 @@
+package Catalyst::AttrContainer;
+
+use strict;
+use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
+
+use Catalyst::Exception;
+use NEXT;
+
+__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache/;
+__PACKAGE__->_attr_cache( {} );
+__PACKAGE__->_action_cache( [] );
+
+# note - see attributes(3pm)
+sub MODIFY_CODE_ATTRIBUTES {
+    my ( $class, $code, @attrs ) = @_;
+    $class->_attr_cache->{$code} = [@attrs];
+    push @{ $class->_action_cache }, [ $code, [@attrs] ];
+    return ();
+}
+
+sub FETCH_CODE_ATTRIBUTES { $_[0]->_attr_cache->{ $_[1] } || () }
+
+=head1 NAME
+
+Catalyst::AttrContainer
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item FETCH_CODE_ATTRIBUTES
+
+=item MODIFY_CODE_ATTRIBUTES
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Marcus Ramberg, C<mramberg@cpan.org>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Catalyst/Base.pm b/lib/Catalyst/Base.pm
index 789c6ab..6bda121 100644
--- a/lib/Catalyst/Base.pm
+++ b/lib/Catalyst/Base.pm
@@ -1,24 +1,65 @@
 package Catalyst::Base;
 
 use strict;
-use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
+use base qw/Catalyst::AttrContainer Class::Accessor::Fast/;
 
 use Catalyst::Exception;
 use NEXT;
 
-__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache _config/;
-__PACKAGE__->_attr_cache( {} );
-__PACKAGE__->_action_cache( [] );
+__PACKAGE__->mk_classdata($_) for qw/_config/;
 
-# note - see attributes(3pm)
-sub MODIFY_CODE_ATTRIBUTES {
-    my ( $class, $code, @attrs ) = @_;
-    $class->_attr_cache->{$code} = [@attrs];
-    push @{ $class->_action_cache }, [ $code, [@attrs] ];
-    return ();
-}
+sub _DISPATCH :Private {
+    my ( $self, $c ) = @_;
+    my @containers = $c->dispatcher->get_containers( $c->namespace );
+    my %actions;
+    foreach my $name (qw/begin auto end/) {
+
+        # Go down the container list representing each part of the
+        # current namespace inheritance tree, grabbing the actions hash
+        # of the ActionContainer object and looking for actions of the
+        # appropriate name registered to the namespace
+
+        $actions{$name} = [
+            map    { $_->{$name} }
+              grep { exists $_->{$name} }
+              map  { $_->actions } @containers
+        ];
+    }
+
+    # Errors break the normal flow and the end action is instantly run
+    my $error = 0;
 
-sub FETCH_CODE_ATTRIBUTES { $_[0]->_attr_cache->{ $_[1] } || () }
+    # Execute last begin
+    $c->state(1);
+    if ( my $begin = @{ $actions{begin} }[-1] ) {
+        $begin->execute($c);
+        $error++ if scalar @{ $c->error };
+    }
+
+    # Execute the auto chain
+    my $autorun = 0;
+    for my $auto ( @{ $actions{auto} } ) {
+        last if $error;
+        $autorun++;
+        $auto->execute($c);
+        $error++ if scalar @{ $c->error };
+        last unless $c->state;
+    }
+
+    # Execute the action or last default
+    my $mkay = $autorun ? $c->state ? 1 : 0 : 1;
+    if ($mkay) {
+        unless ($error) {
+            $c->action->execute($c);
+            $error++ if scalar @{ $c->error };
+        }
+    }
+
+    # Execute last end
+    if ( my $end = @{ $actions{end} }[-1] ) {
+        $end->execute($c);
+    }
+}
 
 =head1 NAME
 
@@ -126,6 +167,7 @@ L<Catalyst>.
 
 Sebastian Riedel, C<sri@cpan.org>
 Marcus Ramberg, C<mramberg@cpan.org>
+Matt S Trout, C<mst@shadowcatsystems.co.uk>
 
 =head1 COPYRIGHT
 
diff --git a/lib/Catalyst/DispatchType/Default.pm b/lib/Catalyst/DispatchType/Default.pm
index faffca1..08a4948 100644
--- a/lib/Catalyst/DispatchType/Default.pm
+++ b/lib/Catalyst/DispatchType/Default.pm
@@ -29,7 +29,7 @@ sub match {
     # Find default on namespace or super
     if ($result) {
         $c->action( $result->[0] );
-        $c->namespace( $c->req->path );
+        $c->namespace( $result->[0]->namespace );
         $c->req->action('default');
         # default methods receive the controller name as the first argument
         unshift @{ $c->req->args }, $path;
diff --git a/lib/Catalyst/DispatchType/Index.pm b/lib/Catalyst/DispatchType/Index.pm
index e0203e6..95ed8b5 100644
--- a/lib/Catalyst/DispatchType/Index.pm
+++ b/lib/Catalyst/DispatchType/Index.pm
@@ -29,7 +29,7 @@ sub match {
     # Find default on namespace or super
     if ($result) {
         $c->action( $result->[0] );
-        $c->namespace( $c->req->path );
+        $c->namespace( $result->[0]->namespace );
         $c->req->action('index');
         $c->req->match( $c->req->path );
         return 1;
diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index 0fa02b5..31e1d02 100644
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -55,56 +55,7 @@ sub dispatch {
     my ( $self, $c ) = @_;
 
     if ( $c->action ) {
-
-        my @containers = $self->get_containers( $c->namespace );
-        my %actions;
-        foreach my $name (qw/begin auto end/) {
-
-            # Go down the container list representing each part of the
-            # current namespace inheritance tree, grabbing the actions hash
-            # of the ActionContainer object and looking for actions of the
-            # appropriate name registered to the namespace
-
-            $actions{$name} = [
-                map    { $_->{$name} }
-                  grep { exists $_->{$name} }
-                  map  { $_->actions } @containers
-            ];
-        }
-
-        # Errors break the normal flow and the end action is instantly run
-        my $error = 0;
-
-        # Execute last begin
-        $c->state(1);
-        if ( my $begin = @{ $actions{begin} }[-1] ) {
-            $begin->execute($c);
-            $error++ if scalar @{ $c->error };
-        }
-
-        # Execute the auto chain
-        my $autorun = 0;
-        for my $auto ( @{ $actions{auto} } ) {
-            last if $error;
-            $autorun++;
-            $auto->execute($c);
-            $error++ if scalar @{ $c->error };
-            last unless $c->state;
-        }
-
-        # Execute the action or last default
-        my $mkay = $autorun ? $c->state ? 1 : 0 : 1;
-        if ($mkay) {
-            unless ($error) {
-                $c->action->execute($c);
-                $error++ if scalar @{ $c->error };
-            }
-        }
-
-        # Execute last end
-        if ( my $end = @{ $actions{end} }[-1] ) {
-            $end->execute($c);
-        }
+        $c->forward( join('/', '', $c->namespace, '_DISPATCH') );
     }
 
     else {
@@ -454,7 +405,7 @@ sub setup_actions {
 
             while ( my $class = shift @cache ) {
                 $classes{$class}++;
-                for my $isa ( @{"$comp\::ISA"} ) {
+                for my $isa ( @{"$class\::ISA"} ) {
                     next if $classes{$isa};
                     push @cache, $isa;
                     $classes{$isa}++;
diff --git a/t/live/lib/TestApp.pm b/t/live/lib/TestApp.pm
index 95d77e2..974e9f3 100644
--- a/t/live/lib/TestApp.pm
+++ b/t/live/lib/TestApp.pm
@@ -34,7 +34,7 @@ sub execute {
         $method = $1;
     }
 
-    if ( $class && $method ) {
+    if ( $class && $method && $method !~ /^_/ ) {
         my $executed = sprintf( "%s->%s", $class, $method );
         my @executed = $c->response->headers->header('X-Catalyst-Executed');
         push @executed, $executed;