X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FController.pm;h=6d3c85a3918811c6d4d5e52b8482fa18e3a35225;hb=e4d346514a2e0b5d239cc22f28205846d00f93bb;hp=8b391df91cc54200820343136855c247ca85bdae;hpb=7f22a5aa91bd859c6e646af2ff45a17eaba7d96a;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index 8b391df..6d3c85a 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -2,7 +2,7 @@ package Catalyst::Controller; use Moose; use Moose::Util qw/find_meta/; - +use List::MoreUtils qw/uniq/; use namespace::clean -except => 'meta'; BEGIN { extends qw/Catalyst::Component MooseX::MethodAttributes::Inheritable/; } @@ -29,9 +29,9 @@ has action_namespace => predicate => 'has_action_namespace', ); -has _controller_actions => +has actions => ( - is => 'rw', + accessor => '_controller_actions', isa => 'HashRef', init_arg => undef, ); @@ -44,6 +44,8 @@ sub BUILD { $self->_controller_actions($attr_value); } + + =head1 NAME Catalyst::Controller - Catalyst Controller base class @@ -135,28 +137,30 @@ around action_namespace => sub { my $orig = shift; my ( $self, $c ) = @_; + my $class = ref($self) || $self; + my $appclass = ref($c) || $c; if( ref($self) ){ return $self->$orig if $self->has_action_namespace; } else { - return $self->config->{namespace} if exists $self->config->{namespace}; + return $class->config->{namespace} if exists $class->config->{namespace}; } my $case_s; if( $c ){ - $case_s = $c->config->{case_sensitive}; + $case_s = $appclass->config->{case_sensitive}; } else { if ($self->isa('Catalyst')) { - $case_s = $self->config->{case_sensitive}; + $case_s = $class->config->{case_sensitive}; } else { if (ref $self) { - $case_s = $self->_application->config->{case_sensitive}; + $case_s = ref($self->_application)->config->{case_sensitive}; } else { confess("Can't figure out case_sensitive setting"); } } } - my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || ''; + my $namespace = Catalyst::Utils::class2prefix($self->catalyst_component_name, $case_s) || ''; $self->$orig($namespace) if ref($self); return $namespace; }; @@ -177,14 +181,29 @@ around path_prefix => sub { sub get_action_methods { my $self = shift; - my $meta = find_meta($self); - confess("Metaclass for " . ref($meta) ." for " . $meta->name - . " cannot support register_actions.") - unless $meta->can('get_nearest_methods_with_attributes'); + my $meta = find_meta($self) || confess("No metaclass setup for $self"); + confess("Metaclass " + . ref($meta) . " for " + . $meta->name + . " cannot support register_actions." ) + unless $meta->can('get_nearest_methods_with_attributes'); my @methods = $meta->get_nearest_methods_with_attributes; - return @methods; + + # actions specified via config are also action_methods + push( + @methods, + map { + $meta->find_method_by_name($_) + || confess( 'Action "' + . $_ + . '" is not available from controller ' + . ( ref $self ) ) + } keys %{ $self->_controller_actions } + ) if ( ref $self ); + return uniq @methods; } + sub register_actions { my ( $self, $c ) = @_; $self->register_action_methods( $c, $self->get_action_methods ); @@ -192,14 +211,17 @@ sub register_actions { sub register_action_methods { my ( $self, $c, @methods ) = @_; - my $class = ref $self || $self; + my $class = $self->catalyst_component_name; #this is still not correct for some reason. my $namespace = $self->action_namespace($c); + if (!blessed($self) && $self eq $c && scalar(@methods)) { + $c->log->warn("Action methods found defined in your application class, $self. This is deprecated, please move them into a Root controller."); + } + foreach my $method (@methods) { my $name = $method->name; my $attributes = $method->attributes; - next unless $attributes; my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } ); if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) { $c->log->debug( 'Bad action definition "' @@ -370,15 +392,14 @@ sub _parse_ChainedParent_attr { } sub _parse_PathPrefix_attr { - my $self = shift; - return PathPart => $self->path_prefix; + my ( $self, $c ) = @_; + return PathPart => $self->path_prefix($c); } sub _parse_ActionClass_attr { my ( $self, $c, $name, $value ) = @_; - unless ( $value =~ s/^\+// ) { - $value = join('::', $self->_action_class, $value ); - } + my $appname = $self->_application; + $value = Catalyst::Utils::resolve_namespace($appname . '::Action', $self->_action_class, $value); return ( 'ActionClass', $value ); } @@ -475,7 +496,7 @@ Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT -This program is free software, you can redistribute it and/or modify +This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut