use base 'Catalyst::Base';
use UNIVERSAL::require;
use Catalyst::Log;
+use Catalyst::Utils;
use Text::ASCIITable;
use Path::Class;
our $CATALYST_SCRIPT_GEN = 4;
$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 )
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
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;
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';
}
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;
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';
use strict;
use attributes ();
+use Path::Class;
=head1 NAME
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.
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