X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FController.pm;h=445d4afee682d8d35bed1c26cadbb6e43d5cc2c3;hp=281986b054dcd0ae08c756a011cf03752af61aa4;hb=0b0aee670c39f8cb8f140eb62de9bfaf2c343a24;hpb=9356b981edac7c7d8a0767b844a7328599acf334 diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index 281986b..445d4af 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -1,12 +1,97 @@ package Catalyst::Controller; -use strict; -use base qw/Catalyst::Component Catalyst::AttrContainer Class::Accessor::Fast/; - +use Moose; +use Class::MOP; +use Class::Load ':all'; +use String::RewritePrefix; +use Moose::Util qw/find_meta/; +use List::Util qw/first/; +use List::MoreUtils qw/uniq/; +use namespace::clean -except => 'meta'; + +BEGIN { extends qw/Catalyst::Component MooseX::MethodAttributes::Inheritable/; } + +use MooseX::MethodAttributes; use Catalyst::Exception; use Catalyst::Utils; -use Class::Inspector; -use NEXT; + +with 'Catalyst::Component::ApplicationAttribute'; + +has path_prefix => ( + is => 'rw', + isa => 'Str', + init_arg => 'path', + predicate => 'has_path_prefix', +); + +has action_namespace => ( + is => 'rw', + isa => 'Str', + init_arg => 'namespace', + predicate => 'has_action_namespace', +); + +has actions => ( + accessor => '_controller_actions', + isa => 'HashRef', + init_arg => undef, +); + +has _action_role_args => ( + traits => [qw(Array)], + isa => 'ArrayRef[Str]', + init_arg => 'action_roles', + default => sub { [] }, + handles => { + _action_role_args => 'elements', + }, +); + +has _action_roles => ( + traits => [qw(Array)], + isa => 'ArrayRef[RoleName]', + init_arg => undef, + lazy => 1, + builder => '_build__action_roles', + handles => { + _action_roles => 'elements', + }, +); + +has action_args => (is => 'ro'); + +# ->config(actions => { '*' => ... +has _all_actions_attributes => ( + is => 'ro', + isa => 'HashRef', + init_arg => undef, + lazy => 1, + builder => '_build__all_actions_attributes', +); + +sub BUILD { + my ($self, $args) = @_; + my $action = delete $args->{action} || {}; + my $actions = delete $args->{actions} || {}; + my $attr_value = $self->merge_config_hashes($actions, $action); + $self->_controller_actions($attr_value); + + # trigger lazy builder + $self->_all_actions_attributes; + $self->_action_roles; +} + +sub _build__action_roles { + my $self = shift; + my @roles = $self->_expand_role_shortname($self->_action_role_args); + load_class($_) for @roles; + return \@roles; +} + +sub _build__all_actions_attributes { + my ($self) = @_; + delete $self->_controller_actions->{'*'} || {}; +} =head1 NAME @@ -17,9 +102,9 @@ Catalyst::Controller - Catalyst Controller base class package MyApp::Controller::Search use base qw/Catalyst::Controller/; - sub foo : Local { + sub foo : Local { my ($self,$c,@args) = @_; - ... + ... } # Dispatches to /search/foo =head1 DESCRIPTION @@ -31,15 +116,14 @@ for more info about how Catalyst dispatches to actions. =cut -__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/; +#I think both of these could be attributes. doesn't really seem like they need +#to ble class data. i think that attributes +default would work just fine +__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class _action_role_prefix/; __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] ); __PACKAGE__->_action_class('Catalyst::Action'); +__PACKAGE__->_action_role_prefix([ 'Catalyst::ActionRole::' ]); -__PACKAGE__->mk_accessors( qw/_application/ ); - -### _app as alias -*_app = *_application; sub _DISPATCH : Private { my ( $self, $c ) = @_; @@ -88,78 +172,119 @@ sub _END : Private { return !@{ $c->error }; } -sub new { - my $self = shift; - my $app = $_[0]; - my $new = $self->NEXT::new(@_); - $new->_application( $app ); - return $new; -} - - sub action_for { my ( $self, $name ) = @_; my $app = ($self->isa('Catalyst') ? $self : $self->_application); return $app->dispatcher->get_action($name, $self->action_namespace); } -sub action_namespace { +#my opinion is that this whole sub really should be a builder method, not +#something that happens on every call. Anyone else disagree?? -- groditi +## -- apparently this is all just waiting for app/ctx split +around action_namespace => sub { + my $orig = shift; my ( $self, $c ) = @_; - unless ( $c ) { - $c = ($self->isa('Catalyst') ? $self : $self->_application); + + my $class = ref($self) || $self; + my $appclass = ref($c) || $c; + if( ref($self) ){ + return $self->$orig if $self->has_action_namespace; + } else { + return $class->config->{namespace} if exists $class->config->{namespace}; } - my $hash = (ref $self ? $self : $self->config); # hate app-is-class - return $hash->{namespace} if exists $hash->{namespace}; - return Catalyst::Utils::class2prefix( ref($self) || $self, - $c->config->{case_sensitive} ) - || ''; -} -sub path_prefix { - my ( $self, $c ) = @_; - unless ( $c ) { - $c = ($self->isa('Catalyst') ? $self : $self->_application); + my $case_s; + if( $c ){ + $case_s = $appclass->config->{case_sensitive}; + } else { + if ($self->isa('Catalyst')) { + $case_s = $class->config->{case_sensitive}; + } else { + if (ref $self) { + $case_s = ref($self->_application)->config->{case_sensitive}; + } else { + confess("Can't figure out case_sensitive setting"); + } + } + } + + my $namespace = Catalyst::Utils::class2prefix($self->catalyst_component_name, $case_s) || ''; + $self->$orig($namespace) if ref($self); + return $namespace; +}; + +#Once again, this is probably better written as a builder method +around path_prefix => sub { + my $orig = shift; + my $self = shift; + if( ref($self) ){ + return $self->$orig if $self->has_path_prefix; + } else { + return $self->config->{path} if exists $self->config->{path}; } - my $hash = (ref $self ? $self : $self->config); # hate app-is-class - return $hash->{path} if exists $hash->{path}; - return shift->action_namespace(@_); + my $namespace = $self->action_namespace(@_); + $self->$orig($namespace) if ref($self); + return $namespace; +}; + +sub get_action_methods { + my $self = shift; + my $meta = find_meta($self) || confess("No metaclass setup for $self"); + confess( + sprintf "Metaclass %s for %s cannot support register_actions.", + ref $meta, $meta->name, + ) unless $meta->can('get_nearest_methods_with_attributes'); + my @methods = $meta->get_nearest_methods_with_attributes; + + # actions specified via config are also action_methods + push( + @methods, + map { + $meta->find_method_by_name($_) + || confess( sprintf 'Action "%s" is not available from controller %s', + $_, ref $self ) + } keys %{ $self->_controller_actions } + ) if ( ref $self ); + return uniq @methods; } sub register_actions { my ( $self, $c ) = @_; - my $class = ref $self || $self; + $self->register_action_methods( $c, $self->get_action_methods ); +} + +sub register_action_methods { + my ( $self, $c, @methods ) = @_; + my $class = $self->catalyst_component_name; + #this is still not correct for some reason. my $namespace = $self->action_namespace($c); - my %methods; - $methods{ $self->can($_) } = $_ - for @{ Class::Inspector->methods($class) || [] }; - # Advanced inheritance support for plugins and the like - my @action_cache; - { - no strict 'refs'; - for my $isa ( @{"$class\::ISA"}, $class ) { - push @action_cache, @{ $isa->_action_cache } - if $isa->can('_action_cache'); + # FIXME - fugly + if (!blessed($self) && $self eq $c && scalar(@methods)) { + my @really_bad_methods = grep { ! /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/ } map { $_->name } @methods; + if (scalar(@really_bad_methods)) { + $c->log->warn("Action methods (" . join(', ', @really_bad_methods) . ") found defined in your application class, $self. This is deprecated, please move them into a Root controller."); } } - foreach my $cache (@action_cache) { - my $code = $cache->[0]; - my $method = delete $methods{$code}; # avoid dupe registers - next unless $method; - my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } ); + foreach my $method (@methods) { + my $name = $method->name; + # Horrible hack! All method metaclasses should have an attributes + # method, core Moose bug - see r13354. + my $attributes = $method->can('attributes') ? $method->attributes : []; + my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } ); if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) { $c->log->debug( 'Bad action definition "' - . join( ' ', @{ $cache->[1] } ) - . qq/" for "$class->$method"/ ) + . join( ' ', @{ $attributes } ) + . qq/" for "$class->$name"/ ) if $c->debug; next; } - my $reverse = $namespace ? "$namespace/$method" : $method; + my $reverse = $namespace ? "${namespace}/${name}" : $name; my $action = $self->create_action( - name => $method, - code => $code, + name => $name, + code => $method->body, reverse => $reverse, namespace => $namespace, class => $class, @@ -170,19 +295,68 @@ sub register_actions { } } -sub create_action { +sub _apply_action_class_roles { + my ($self, $class, @roles) = @_; + + load_class($_) for @roles; + my $meta = Moose::Meta::Class->initialize($class)->create_anon_class( + superclasses => [$class], + roles => \@roles, + cache => 1, + ); + $meta->add_method(meta => sub { $meta }); + + return $meta->name; +} + +sub action_class { my $self = shift; my %args = @_; my $class = (exists $args{attributes}{ActionClass} - ? $args{attributes}{ActionClass}[0] - : $self->_action_class); + ? $args{attributes}{ActionClass}[0] + : $self->_action_class); - unless ( Class::Inspector->loaded($class) ) { - require Class::Inspector->filename($class); + Class::MOP::load_class($class); + return $class; +} + +sub create_action { + my $self = shift; + my %args = @_; + + my $class = $self->action_class(%args); + + load_class($class); + Moose->init_meta(for_class => $class) + unless Class::MOP::does_metaclass_exist($class); + + unless ($args{name} =~ /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/) { + my @roles = $self->gather_action_roles(%args); + $class = $self->_apply_action_class_roles($class, @roles) if @roles; } - - return $class->new( \%args ); + + my $action_args = ( + ref($self) + ? $self->action_args + : $self->config->{action_args} + ); + + my %extra_args = ( + %{ $action_args->{'*'} || {} }, + %{ $action_args->{ $args{name} } || {} }, + ); + + return $class->new({ %extra_args, %args }); +} + +sub gather_action_roles { + my ($self, %args) = @_; + + return ( + (blessed $self ? $self->_action_roles : ()), + @{ $args{attributes}->{Does} || [] }, + ); } sub _parse_attrs { @@ -204,27 +378,59 @@ sub _parse_attrs { } } - my $hash = (ref $self ? $self : $self->config); # hate app-is-class - - if (exists $hash->{actions} || exists $hash->{action}) { - my $a = $hash->{actions} || $hash->{action}; - %raw_attributes = ((exists $a->{'*'} ? %{$a->{'*'}} : ()), - %raw_attributes, - (exists $a->{$name} ? %{$a->{$name}} : ())); + my ($actions_config, $all_actions_config); + if( ref($self) ) { + $actions_config = $self->_controller_actions; + # No, you're not getting actions => { '*' => ... } with actions in MyApp. + $all_actions_config = $self->_all_actions_attributes; + } else { + my $cfg = $self->config; + $actions_config = $self->merge_config_hashes($cfg->{actions}, $cfg->{action}); + $all_actions_config = {}; } + %raw_attributes = ( + %raw_attributes, + # Note we deep copy array refs here to stop crapping on config + # when attributes are parsed. RT#65463 + exists $actions_config->{$name} ? map { ref($_) eq 'ARRAY' ? [ @$_ ] : $_ } %{ $actions_config->{$name } } : (), + ); + + # Private actions with additional attributes will raise a warning and then + # be ignored. Adding '*' arguments to the default _DISPATCH / etc. methods, + # which are Private, will prevent those from being registered. They should + # probably be turned into :Actions instead, or we might want to otherwise + # disambiguate between those built-in internal actions and user-level + # Private ones. + %raw_attributes = (%{ $all_actions_config }, %raw_attributes) + unless $raw_attributes{Private}; + my %final_attributes; - foreach my $key (keys %raw_attributes) { + while (my ($key, $value) = each %raw_attributes){ + my $new_attrs = $self->_parse_attr($c, $name, $key => $value ); + push @{ $final_attributes{$_} }, @{ $new_attrs->{$_} } for keys %$new_attrs; + } - my $raw = $raw_attributes{$key}; + return \%final_attributes; +} - foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) { +sub _parse_attr { + my ($self, $c, $name, $key, $values) = @_; - my $meth = "_parse_${key}_attr"; - if ( $self->can($meth) ) { - ( $key, $value ) = $self->$meth( $c, $name, $value ); + my %final_attributes; + foreach my $value (ref($values) eq 'ARRAY' ? @$values : $values) { + my $meth = "_parse_${key}_attr"; + if ( my $code = $self->can($meth) ) { + my %new_attrs = $self->$code( $c, $name, $value ); + while (my ($new_key, $value) = each %new_attrs){ + my $new_attrs = $key eq $new_key ? + { $new_key => [$value] } : + $self->_parse_attr($c, $name, $new_key => $value ); + push @{ $final_attributes{$_} }, @{ $new_attrs->{$_} } for keys %$new_attrs; } + } + else { push( @{ $final_attributes{$key} }, $value ); } } @@ -234,14 +440,16 @@ sub _parse_attrs { sub _parse_Global_attr { my ( $self, $c, $name, $value ) = @_; - return $self->_parse_Path_attr( $c, $name, "/$name" ); + # _parse_attr will call _parse_Path_attr for us + return Path => "/$name"; } sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); } sub _parse_Local_attr { my ( $self, $c, $name, $value ) = @_; - return $self->_parse_Path_attr( $c, $name, $name ); + # _parse_attr will call _parse_Path_attr for us + return Path => $name; } sub _parse_Relative_attr { shift->_parse_Local_attr(@_); } @@ -273,7 +481,7 @@ sub _parse_LocalRegex_attr { my $prefix = $self->path_prefix( $c ); $prefix .= '/' if length( $prefix ); - + return ( 'Regex', "^${prefix}${value}" ); } @@ -285,9 +493,11 @@ sub _parse_Chained_attr { if (defined($value) && length($value)) { if ($value eq '.') { $value = '/'.$self->action_namespace($c); - } elsif (my ($rest) = $value =~ /^\.{2}\/(.*)$/) { + } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) { my @parts = split '/', $self->action_namespace($c); - $value = '/'.join('/', @parts[0 .. $#parts-1], $rest); + my @levels = split '/', $rel; + + $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest); } elsif ($value !~ m/^\//) { my $action_ns = $self->action_namespace($c); @@ -310,15 +520,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 ); } @@ -326,11 +535,39 @@ sub _parse_MyAction_attr { my ( $self, $c, $name, $value ) = @_; my $appclass = Catalyst::Utils::class2appclass($self); - $value = "${appclass}::Action::${value}"; + $value = "+${appclass}::Action::${value}"; return ( 'ActionClass', $value ); } +sub _parse_Does_attr { + my ($self, $app, $name, $value) = @_; + return Does => $self->_expand_role_shortname($value); +} + +sub _expand_role_shortname { + my ($self, @shortnames) = @_; + my $app = $self->_application; + + my $prefix = $self->can('_action_role_prefix') ? $self->_action_role_prefix : ['Catalyst::ActionRole::']; + my @prefixes = (qq{${app}::ActionRole::}, @$prefix); + + return String::RewritePrefix->rewrite( + { '' => sub { + my $loaded = load_first_existing_class( + map { "$_$_[0]" } @prefixes + ); + return first { $loaded =~ /^$_/ } + sort { length $b <=> length $a } @prefixes; + }, + '~' => $prefixes[0], + '+' => '' }, + @shortnames, + ); +} + +__PACKAGE__->meta->make_immutable; + 1; __END__ @@ -349,28 +586,62 @@ controller name. For instance controller 'MyApp::Controller::Foo::Bar' will be bound to 'foo/bar'. The default Root controller is an example of setting namespace to '' (the null string). -=head2 path +=head2 path Sets 'path_prefix', as described below. +=head2 action + +Allows you to set the attributes that the dispatcher creates actions out of. +This allows you to do 'rails style routes', or override some of the +attribute definitions of actions composed from Roles. +You can set arguments globally (for all actions of the controller) and +specifically (for a single action). + + __PACKAGE__->config( + action => { + '*' => { Chained => 'base', Args => 0 }, + base => { Chained => '/', PathPart => '', CaptureArgs => 0 }, + }, + ); + +In the case above every sub in the package would be made into a Chain +endpoint with a URI the same as the sub name for each sub, chained +to the sub named C. Ergo dispatch to C would call the +C method, then the C method. + +=head2 action_args + +Allows you to set constructor arguments on your actions. You can set arguments +globally and specifically (as above). +This is particularly useful when using Cs +(L) and custom Ces. + + __PACKAGE__->config( + action_args => { + '*' => { globalarg1 => 'hello', globalarg2 => 'goodbye' }, + 'specific_action' => { customarg => 'arg1' }, + }, + ); + +In the case above the action class associated with C would get +passed the following arguments, in addition to the normal action constructor +arguments, when it is instantiated: + + (globalarg1 => 'hello', globalarg2 => 'goodbye', customarg => 'arg1') + =head1 METHODS -=head2 $class->new($app, @args) +=head2 BUILDARGS ($app, @args) -Proxies through to NEXT::new and stashes the application instance as -$self->_application. +From L, stashes the application +instance as $self->_application. =head2 $self->action_for('name') Returns the Catalyst::Action object (if any) for a given method name in this component. -=head2 $self->register_actions($c) - -Finds all applicable actions for this component, creates -Catalyst::Action objects (using $self->create_action) for them and -registers them with $c->dispatcher. - =head2 $self->action_namespace($c) Returns the private namespace for actions in this component. Defaults @@ -385,12 +656,36 @@ Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and relative :Path actions in this component. Defaults to the action_namespace or can be overridden from the "path" config key. +=head2 $self->register_actions($c) + +Finds all applicable actions for this component, creates +Catalyst::Action objects (using $self->create_action) for them and +registers them with $c->dispatcher. + +=head2 $self->get_action_methods() + +Returns a list of L objects, doing the +L role, which are the set of +action methods for this package. + +=head2 $self->register_action_methods($c, @methods) + +Creates action objects for a set of action methods using C< create_action >, +and registers them with the dispatcher. + +=head2 $self->action_class(%args) + +Used when a controller is creating an action to determine the correct base +action class to use. + =head2 $self->create_action(%args) Called with a hash of data to be use for construction of a new Catalyst::Action (or appropriate sub/alternative class) object. -Primarily designed for the use of register_actions. +=head2 $self->gather_action_roles(\%action_args) + +Gathers the list of roles to apply to an action with the given %action_args. =head2 $self->_application @@ -404,7 +699,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