Updated some core stuff, cleanups, better errors...

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 26b4cac..36e6da0 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -4,6 +4,7 @@ use strict;
 use base 'Catalyst::Base';
 use UNIVERSAL::require;
 use Catalyst::Log;
+use Catalyst::Utils;
 use Text::ASCIITable;
 use Path::Class;
 our $CATALYST_SCRIPT_GEN = 4;
@@ -246,19 +247,7 @@ sub import {
     $caller->log->debug(qq/Loaded engine "$engine"/) if $caller->debug;
 
     # Find home
-    my $name = $caller;
-    $name =~ s/\:\:/\//g;
-    my $home;
-    if ( my $path = $INC{"$name.pm"} ) {
-        $home = file($path)->absolute->dir;
-        $name =~ /(\w+)$/;
-        my $append = $1;
-        my $subdir = dir($home)->subdir($append);
-        for ( split '/', $name ) { $home = dir($home)->parent }
-        if ( $home =~ /blib$/ ) { $home = dir($home)->parent }
-        elsif ( !-f file( $home, 'Makefile.PL' ) ) { $home = $subdir }
-    }
-
+    my $home = Catalyst::Utils::home($caller);
     if ( $caller->debug ) {
         $home
           ? ( -d $home )

diff --git a/lib/Catalyst/Base.pm b/lib/Catalyst/Base.pm
index 869d474..64848c0 100644 (file)
--- a/lib/Catalyst/Base.pm
+++ b/lib/Catalyst/Base.pm
@@ -5,19 +5,19 @@ use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
 use Catalyst::Utils;
 use NEXT;
 
-__PACKAGE__->mk_classdata($_) for qw/_attrcache _cache _config/;
-__PACKAGE__->_attrcache( {} );
-__PACKAGE__->_cache( [] );
+__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache _config/;
+__PACKAGE__->_attr_cache( {} );
+__PACKAGE__->_action_cache( [] );
 
 # note - see attributes(3pm)
 sub MODIFY_CODE_ATTRIBUTES {
     my ( $class, $code, @attrs ) = @_;
-    $class->_attrcache->{$code} = [@attrs];
-    push @{ $class->_cache }, [ $code, [@attrs] ];
+    $class->_attr_cache->{$code} = [@attrs];
+    push @{ $class->_action_cache }, [ $code, [@attrs] ];
     return ();
 }
 
-sub FETCH_CODE_ATTRIBUTES { $_[0]->_attrcache->{ $_[1] } || () }
+sub FETCH_CODE_ATTRIBUTES { $_[0]->_attr_cache->{ $_[1] } || () }
 
 =head1 NAME
 
@@ -92,7 +92,7 @@ sub new {
 sub config {
     my $self = shift;
     $self->_config( {} ) unless $self->_config;
-    if ( @_ ) {
+    if (@_) {
         my $config = @_ > 1 ? {@_} : $_[0];
         while ( my ( $key, $val ) = each %$config ) {
             $self->_config->{$key} = $val;

diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index 33d497f..3550392 100644 (file)
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -135,21 +135,23 @@ sub forward {
 
     unless ( @{$results} ) {
         my $class = $command || '';
-        my $path  = $class . '.pm';
+        my $path = $class . '.pm';
         $path =~ s/::/\//g;
 
-        unless ( $INC{ $path } ) {
-            my $error = qq/Couldn't forward to "$class". Invalid or not loaded./;
+        unless ( $INC{$path} ) {
+            my $error =
+              qq/Couldn't forward to "$class". Invalid or not loaded./;
             $c->error($error);
             $c->log->debug($error) if $c->debug;
             return 0;
         }
-        
+
         unless ( UNIVERSAL::isa( $class, 'Catalyst::Base' ) ) {
-            my $error = qq/Can't forward to "$class". Class is not a Catalyst component./;
+            my $error =
+              qq/Can't forward to "$class". Class is not a Catalyst component./;
             $c->error($error);
             $c->log->debug($error) if $c->debug;
-            return 0;            
+            return 0;
         }
 
         my $method = shift || 'process';
@@ -160,7 +162,8 @@ sub forward {
         }
 
         else {
-            my $error = qq/Couldn't forward to "$class". Does not implement "$method"/;
+            my $error =
+              qq/Couldn't forward to "$class". Does not implement "$method"/;
             $c->error($error);
             $c->log->debug($error)
               if $c->debug;
@@ -354,7 +357,7 @@ sub setup_actions {
     for my $comp (@$comps) {
         $comp = ref $comp || $comp;
 
-        for my $action ( @{ $comp->_cache } ) {
+        for my $action ( @{ Catalyst::Utils::reflect_actions($comp) } ) {
             my ( $code, $attrs ) = @{$action};
             my $name = '';
             no strict 'refs';

diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm
index 785c607..e1b6440 100644 (file)
--- a/lib/Catalyst/Utils.pm
+++ b/lib/Catalyst/Utils.pm
@@ -2,6 +2,7 @@ package Catalyst::Utils;
 
 use strict;
 use attributes ();
+use Path::Class;
 
 =head1 NAME
 
@@ -25,21 +26,6 @@ Returns attributes for coderef in a arrayref
 
 sub attrs { attributes::get( $_[0] ) || [] }
 
-=item prefix($class, $name);
-
-Returns a prefixed action.
-
-    MyApp::C::Foo::Bar, yada becomes /foo/bar/yada
-
-=cut
-
-sub prefix {
-    my ( $class, $name ) = @_;
-    my $prefix = &class2prefix($class);
-    $name = "$prefix/$name" if $prefix;
-    return $name;
-}
-
 =item class2appclass($class);
 
 Returns the appclass for class.
@@ -109,6 +95,57 @@ sub class2prefix {
     return $prefix;
 }
 
+=item home($class)
+
+Returns home directory for given class.
+
+=cut
+
+sub home {
+    my $name = shift;
+    $name =~ s/\:\:/\//g;
+    my $home = 0;
+    if ( my $path = $INC{"$name.pm"} ) {
+        $home = file($path)->absolute->dir;
+        $name =~ /(\w+)$/;
+        my $append = $1;
+        my $subdir = dir($home)->subdir($append);
+        for ( split '/', $name ) { $home = dir($home)->parent }
+        if ( $home =~ /blib$/ ) { $home = dir($home)->parent }
+        elsif ( !-f file( $home, 'Makefile.PL' ) ) { $home = $subdir }
+    }
+    return $home;
+}
+
+=item prefix($class, $name);
+
+Returns a prefixed action.
+
+    MyApp::C::Foo::Bar, yada becomes /foo/bar/yada
+
+=cut
+
+sub prefix {
+    my ( $class, $name ) = @_;
+    my $prefix = &class2prefix($class);
+    $name = "$prefix/$name" if $prefix;
+    return $name;
+}
+
+=item reflect_actions($class);
+
+Returns an arrayref containing all actions of a component class.
+
+=cut
+
+sub reflect_actions {
+    my $class   = shift;
+    my $actions = [];
+    eval '$actions = $class->_action_cache';
+    die qq/Couldn't reflect actions of component "$class", "$@"/ if $@;
+    return $actions;
+}
+
 =back
 
 =head1 AUTHOR