From: Sebastian Riedel Date: Sat, 30 Apr 2005 03:10:28 +0000 (+0000) Subject: Updated some core stuff, cleanups, better errors... X-Git-Tag: 5.7099_04~1415 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=812a28c90c5b43bdf5ce87f1b2a688725e552429 Updated some core stuff, cleanups, better errors... --- diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 26b4cac..36e6da0 100644 --- 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 --- 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 --- 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 --- 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