1 package Catalyst::Controller;
4 use Moose::Util qw/find_meta/;
5 use List::MoreUtils qw/uniq/;
6 use namespace::clean -except => 'meta';
8 BEGIN { extends qw/Catalyst::Component MooseX::MethodAttributes::Inheritable/; }
10 use MooseX::MethodAttributes;
11 use Catalyst::Exception;
14 with 'Catalyst::Component::ApplicationAttribute';
21 predicate => 'has_path_prefix',
24 has action_namespace =>
28 init_arg => 'namespace',
29 predicate => 'has_action_namespace',
34 accessor => '_controller_actions',
39 # ->config(actions => { '*' => ...
40 has _all_actions_attributes => (
45 builder => '_build__all_actions_attributes',
49 my ($self, $args) = @_;
50 my $action = delete $args->{action} || {};
51 my $actions = delete $args->{actions} || {};
52 my $attr_value = $self->merge_config_hashes($actions, $action);
53 $self->_controller_actions($attr_value);
55 # trigger lazy builder
56 $self->_all_actions_attributes;
59 sub _build__all_actions_attributes {
61 delete $self->_controller_actions->{'*'} || {};
66 Catalyst::Controller - Catalyst Controller base class
70 package MyApp::Controller::Search
71 use base qw/Catalyst::Controller/;
74 my ($self,$c,@args) = @_;
76 } # Dispatches to /search/foo
80 Controllers are where the actions in the Catalyst framework
81 reside. Each action is represented by a function with an attribute to
82 identify what kind of action it is. See the L<Catalyst::Dispatcher>
83 for more info about how Catalyst dispatches to actions.
87 #I think both of these could be attributes. doesn't really seem like they need
88 #to ble class data. i think that attributes +default would work just fine
89 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
91 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
92 __PACKAGE__->_action_class('Catalyst::Action');
95 sub _DISPATCH : Private {
96 my ( $self, $c ) = @_;
98 foreach my $disp ( @{ $self->_dispatch_steps } ) {
99 last unless $c->forward($disp);
105 sub _BEGIN : Private {
106 my ( $self, $c ) = @_;
107 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
108 return 1 unless $begin;
109 $begin->dispatch( $c );
110 return !@{ $c->error };
113 sub _AUTO : Private {
114 my ( $self, $c ) = @_;
115 my @auto = $c->get_actions( 'auto', $c->namespace );
116 foreach my $auto (@auto) {
117 $auto->dispatch( $c );
118 return 0 unless $c->state;
123 sub _ACTION : Private {
124 my ( $self, $c ) = @_;
126 && $c->action->can('execute')
127 && defined $c->req->action )
129 $c->action->dispatch( $c );
131 return !@{ $c->error };
135 my ( $self, $c ) = @_;
136 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
137 return 1 unless $end;
138 $end->dispatch( $c );
139 return !@{ $c->error };
143 my ( $self, $name ) = @_;
144 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
145 return $app->dispatcher->get_action($name, $self->action_namespace);
148 #my opinion is that this whole sub really should be a builder method, not
149 #something that happens on every call. Anyone else disagree?? -- groditi
150 ## -- apparently this is all just waiting for app/ctx split
151 around action_namespace => sub {
153 my ( $self, $c ) = @_;
155 my $class = ref($self) || $self;
156 my $appclass = ref($c) || $c;
158 return $self->$orig if $self->has_action_namespace;
160 return $class->config->{namespace} if exists $class->config->{namespace};
165 $case_s = $appclass->config->{case_sensitive};
167 if ($self->isa('Catalyst')) {
168 $case_s = $class->config->{case_sensitive};
171 $case_s = ref($self->_application)->config->{case_sensitive};
173 confess("Can't figure out case_sensitive setting");
178 my $namespace = Catalyst::Utils::class2prefix($self->catalyst_component_name, $case_s) || '';
179 $self->$orig($namespace) if ref($self);
183 #Once again, this is probably better written as a builder method
184 around path_prefix => sub {
188 return $self->$orig if $self->has_path_prefix;
190 return $self->config->{path} if exists $self->config->{path};
192 my $namespace = $self->action_namespace(@_);
193 $self->$orig($namespace) if ref($self);
197 sub get_action_methods {
199 my $meta = find_meta($self) || confess("No metaclass setup for $self");
201 sprintf "Metaclass %s for %s cannot support register_actions.",
202 ref $meta, $meta->name,
203 ) unless $meta->can('get_nearest_methods_with_attributes');
204 my @methods = $meta->get_nearest_methods_with_attributes;
206 # actions specified via config are also action_methods
210 $meta->find_method_by_name($_)
211 || confess( sprintf 'Action "%s" is not available from controller %s',
213 } keys %{ $self->_controller_actions }
215 return uniq @methods;
219 sub register_actions {
220 my ( $self, $c ) = @_;
221 $self->register_action_methods( $c, $self->get_action_methods );
224 sub register_action_methods {
225 my ( $self, $c, @methods ) = @_;
226 my $class = $self->catalyst_component_name;
227 #this is still not correct for some reason.
228 my $namespace = $self->action_namespace($c);
231 if (!blessed($self) && $self eq $c && scalar(@methods)) {
232 my @really_bad_methods = grep { ! /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/ } map { $_->name } @methods;
233 if (scalar(@really_bad_methods)) {
234 $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.");
238 foreach my $method (@methods) {
239 my $name = $method->name;
240 # Horrible hack! All method metaclasses should have an attributes
241 # method, core Moose bug - see r13354.
242 my $attributes = $method->can('attributes') ? $method->attributes : [];
243 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
244 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
245 $c->log->debug( 'Bad action definition "'
246 . join( ' ', @{ $attributes } )
247 . qq/" for "$class->$name"/ )
251 my $reverse = $namespace ? "${namespace}/${name}" : $name;
252 my $action = $self->create_action(
254 code => $method->body,
256 namespace => $namespace,
258 attributes => $attrs,
261 $c->dispatcher->register( $c, $action );
269 my $class = (exists $args{attributes}{ActionClass}
270 ? $args{attributes}{ActionClass}[0]
271 : $self->_action_class);
273 Class::MOP::load_class($class);
281 my $class = $self->action_class(%args);
282 my $action_args = $self->config->{action_args};
285 %{ $action_args->{'*'} || {} },
286 %{ $action_args->{ $args{name} } || {} },
289 return $class->new({ %extra_args, %args });
293 my ( $self, $c, $name, @attrs ) = @_;
297 foreach my $attr (@attrs) {
299 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
301 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
304 if ( defined $value ) {
305 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
307 push( @{ $raw_attributes{$key} }, $value );
311 my ($actions_config, $all_actions_config);
313 $actions_config = $self->_controller_actions;
314 # No, you're not getting actions => { '*' => ... } with actions in MyApp.
315 $all_actions_config = $self->_all_actions_attributes;
317 my $cfg = $self->config;
318 $actions_config = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
319 $all_actions_config = {};
324 exists $actions_config->{$name} ? %{ $actions_config->{$name } } : (),
327 # Private actions with additional attributes will raise a warning and then
328 # be ignored. Adding '*' arguments to the default _DISPATCH / etc. methods,
329 # which are Private, will prevent those from being registered. They should
330 # probably be turned into :Actions instead, or we might want to otherwise
331 # disambiguate between those built-in internal actions and user-level
333 %raw_attributes = (%{ $all_actions_config }, %raw_attributes)
334 unless $raw_attributes{Private};
336 my %final_attributes;
338 foreach my $key (keys %raw_attributes) {
340 my $raw = $raw_attributes{$key};
342 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
344 my $meth = "_parse_${key}_attr";
345 if ( my $code = $self->can($meth) ) {
346 ( $key, $value ) = $self->$code( $c, $name, $value );
348 push( @{ $final_attributes{$key} }, $value );
352 return \%final_attributes;
355 sub _parse_Global_attr {
356 my ( $self, $c, $name, $value ) = @_;
357 return $self->_parse_Path_attr( $c, $name, "/$name" );
360 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
362 sub _parse_Local_attr {
363 my ( $self, $c, $name, $value ) = @_;
364 return $self->_parse_Path_attr( $c, $name, $name );
367 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
369 sub _parse_Path_attr {
370 my ( $self, $c, $name, $value ) = @_;
371 $value = '' if !defined $value;
372 if ( $value =~ m!^/! ) {
373 return ( 'Path', $value );
375 elsif ( length $value ) {
376 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
379 return ( 'Path', $self->path_prefix($c) );
383 sub _parse_Regex_attr {
384 my ( $self, $c, $name, $value ) = @_;
385 return ( 'Regex', $value );
388 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
390 sub _parse_LocalRegex_attr {
391 my ( $self, $c, $name, $value ) = @_;
392 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
394 my $prefix = $self->path_prefix( $c );
395 $prefix .= '/' if length( $prefix );
397 return ( 'Regex', "^${prefix}${value}" );
400 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
402 sub _parse_Chained_attr {
403 my ($self, $c, $name, $value) = @_;
405 if (defined($value) && length($value)) {
407 $value = '/'.$self->action_namespace($c);
408 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
409 my @parts = split '/', $self->action_namespace($c);
410 my @levels = split '/', $rel;
412 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
413 } elsif ($value !~ m/^\//) {
414 my $action_ns = $self->action_namespace($c);
417 $value = '/'.join('/', $action_ns, $value);
419 $value = '/'.$value; # special case namespace '' (root)
426 return Chained => $value;
429 sub _parse_ChainedParent_attr {
430 my ($self, $c, $name, $value) = @_;
431 return $self->_parse_Chained_attr($c, $name, '../'.$name);
434 sub _parse_PathPrefix_attr {
435 my ( $self, $c ) = @_;
436 return PathPart => $self->path_prefix($c);
439 sub _parse_ActionClass_attr {
440 my ( $self, $c, $name, $value ) = @_;
441 my $appname = $self->_application;
442 $value = Catalyst::Utils::resolve_namespace($appname . '::Action', $self->_action_class, $value);
443 return ( 'ActionClass', $value );
446 sub _parse_MyAction_attr {
447 my ( $self, $c, $name, $value ) = @_;
449 my $appclass = Catalyst::Utils::class2appclass($self);
450 $value = "${appclass}::Action::${value}";
452 return ( 'ActionClass', $value );
455 __PACKAGE__->meta->make_immutable;
463 Like any other L<Catalyst::Component>, controllers have a config hash,
464 accessible through $self->config from the controller actions. Some
465 settings are in use by the Catalyst framework:
469 This specifies the internal namespace the controller should be bound
470 to. By default the controller is bound to the URI version of the
471 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
472 will be bound to 'foo/bar'. The default Root controller is an example
473 of setting namespace to '' (the null string).
477 Sets 'path_prefix', as described below.
481 Allows you to set the attributes that the dispatcher creates actions out of.
482 This allows you to do 'rails style routes', or override some of the
483 attribute defintions of actions composed from Roles.
484 You can set arguments globally (for all actions of the controller) and
485 specifically (for a single action).
489 '*' => { Chained => 'base', Args => 0 },
490 base => { Chained => '/', PathPart => '', CaptureArgs => 0 },
494 In the case above every sub in the package would be made into a Chain
495 endpoint with a URI the same as the sub name for each sub, chained
496 to the sub named C<base>. Ergo dispatch to C</example> would call the
497 C<base> method, then the C<example> method.
501 Allows you to set constructor arguments on your actions. You can set arguments
502 globally and specifically (as above).
503 This is particularly useful when using C<ActionRole>s
504 (L<Catalyst::Controller::ActionRole>) and custom C<ActionClass>es.
508 '*' => { globalarg1 => 'hello', globalarg2 => 'goodbye' },
509 'specific_action' => { customarg => 'arg1' },
513 In the case above the action class associated with C<specific_action> would get
514 passed the following arguments, in addition to the normal action constructor
515 arguments, when it is instantiated:
517 (globalarg1 => 'hello', globalarg2 => 'goodbye', customarg => 'arg1')
521 =head2 BUILDARGS ($app, @args)
523 From L<Catalyst::Component::ApplicationAttribute>, stashes the application
524 instance as $self->_application.
526 =head2 $self->action_for('name')
528 Returns the Catalyst::Action object (if any) for a given method name
531 =head2 $self->action_namespace($c)
533 Returns the private namespace for actions in this component. Defaults
534 to a value from the controller name (for
535 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
536 overridden from the "namespace" config key.
539 =head2 $self->path_prefix($c)
541 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
542 relative :Path actions in this component. Defaults to the action_namespace or
543 can be overridden from the "path" config key.
545 =head2 $self->register_actions($c)
547 Finds all applicable actions for this component, creates
548 Catalyst::Action objects (using $self->create_action) for them and
549 registers them with $c->dispatcher.
551 =head2 $self->get_action_methods()
553 Returns a list of L<Moose::Meta::Method> objects, doing the
554 L<MooseX::MethodAttributes::Role::Meta::Method> role, which are the set of
555 action methods for this package.
557 =head2 $self->register_action_methods($c, @methods)
559 Creates action objects for a set of action methods using C< create_action >,
560 and registers them with the dispatcher.
562 =head2 $self->action_class(%args)
564 Used when a controller is creating an action to determine the correct base
567 =head2 $self->create_action(%args)
569 Called with a hash of data to be use for construction of a new
570 Catalyst::Action (or appropriate sub/alternative class) object.
572 =head2 $self->_application
576 Returns the application instance stored by C<new()>
580 Catalyst Contributors, see Catalyst.pm
584 This library is free software. You can redistribute it and/or modify
585 it under the same terms as Perl itself.