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',
40 my ($self, $args) = @_;
41 my $action = delete $args->{action} || {};
42 my $actions = delete $args->{actions} || {};
43 my $attr_value = $self->merge_config_hashes($actions, $action);
44 $self->_controller_actions($attr_value);
51 Catalyst::Controller - Catalyst Controller base class
55 package MyApp::Controller::Search
56 use base qw/Catalyst::Controller/;
59 my ($self,$c,@args) = @_;
61 } # Dispatches to /search/foo
65 Controllers are where the actions in the Catalyst framework
66 reside. Each action is represented by a function with an attribute to
67 identify what kind of action it is. See the L<Catalyst::Dispatcher>
68 for more info about how Catalyst dispatches to actions.
72 #I think both of these could be attributes. doesn't really seem like they need
73 #to ble class data. i think that attributes +default would work just fine
74 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
76 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
77 __PACKAGE__->_action_class('Catalyst::Action');
80 sub _DISPATCH : Private {
81 my ( $self, $c ) = @_;
83 foreach my $disp ( @{ $self->_dispatch_steps } ) {
84 last unless $c->forward($disp);
90 sub _BEGIN : Private {
91 my ( $self, $c ) = @_;
92 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
93 return 1 unless $begin;
94 $begin->dispatch( $c );
95 return !@{ $c->error };
99 my ( $self, $c ) = @_;
100 my @auto = $c->get_actions( 'auto', $c->namespace );
101 foreach my $auto (@auto) {
102 $auto->dispatch( $c );
103 return 0 unless $c->state;
108 sub _ACTION : Private {
109 my ( $self, $c ) = @_;
111 && $c->action->can('execute')
112 && defined $c->req->action )
114 $c->action->dispatch( $c );
116 return !@{ $c->error };
120 my ( $self, $c ) = @_;
121 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
122 return 1 unless $end;
123 $end->dispatch( $c );
124 return !@{ $c->error };
128 my ( $self, $name ) = @_;
129 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
130 return $app->dispatcher->get_action($name, $self->action_namespace);
133 #my opinion is that this whole sub really should be a builder method, not
134 #something that happens on every call. Anyone else disagree?? -- groditi
135 ## -- apparently this is all just waiting for app/ctx split
136 around action_namespace => sub {
138 my ( $self, $c ) = @_;
140 my $class = ref($self) || $self;
142 return $self->$orig if $self->has_action_namespace;
144 return $class->config->{namespace} if exists $class->config->{namespace};
147 my $namespace = Catalyst::Utils::class2prefix($self->catalyst_component_name) || '';
148 $self->$orig($namespace) if ref($self);
152 #Once again, this is probably better written as a builder method
153 around path_prefix => sub {
157 return $self->$orig if $self->has_path_prefix;
159 return $self->config->{path} if exists $self->config->{path};
161 my $namespace = $self->action_namespace(@_);
162 $self->$orig($namespace) if ref($self);
166 sub get_action_methods {
168 my $meta = find_meta($self) || confess("No metaclass setup for $self");
170 . ref($meta) . " for "
172 . " cannot support register_actions." )
173 unless $meta->can('get_nearest_methods_with_attributes');
174 my @methods = $meta->get_nearest_methods_with_attributes;
176 # actions specified via config are also action_methods
180 $meta->find_method_by_name($_)
181 || confess( 'Action "'
183 . '" is not available from controller '
185 } keys %{ $self->_controller_actions }
187 return uniq @methods;
191 sub register_actions {
192 my ( $self, $c ) = @_;
193 $self->register_action_methods( $c, $self->get_action_methods );
196 sub register_action_methods {
197 my ( $self, $c, @methods ) = @_;
198 my $class = $self->catalyst_component_name;
199 #this is still not correct for some reason.
200 my $namespace = $self->action_namespace($c);
203 if (!blessed($self) && $self eq $c && scalar(@methods)) {
204 my @really_bad_methods = grep { ! /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/ } map { $_->name } @methods;
205 if (scalar(@really_bad_methods)) {
206 $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.");
210 foreach my $method (@methods) {
211 my $name = $method->name;
212 my $attributes = $method->attributes;
213 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
214 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
215 $c->log->debug( 'Bad action definition "'
216 . join( ' ', @{ $attributes } )
217 . qq/" for "$class->$name"/ )
221 my $reverse = $namespace ? "${namespace}/${name}" : $name;
222 my $action = $self->create_action(
224 code => $method->body,
226 namespace => $namespace,
228 attributes => $attrs,
231 $c->dispatcher->register( $c, $action );
239 my $class = (exists $args{attributes}{ActionClass}
240 ? $args{attributes}{ActionClass}[0]
241 : $self->_action_class);
243 Class::MOP::load_class($class);
244 return $class->new( \%args );
248 my ( $self, $c, $name, @attrs ) = @_;
252 foreach my $attr (@attrs) {
254 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
256 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
259 if ( defined $value ) {
260 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
262 push( @{ $raw_attributes{$key} }, $value );
266 #I know that the original behavior was to ignore action if actions was set
267 # but i actually think this may be a little more sane? we can always remove
268 # the merge behavior quite easily and go back to having actions have
269 # presedence over action by modifying the keys. i honestly think this is
270 # superior while mantaining really high degree of compat
273 $actions = $self->_controller_actions;
275 my $cfg = $self->config;
276 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
279 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
281 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
284 my %final_attributes;
286 foreach my $key (keys %raw_attributes) {
288 my $raw = $raw_attributes{$key};
290 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
292 my $meth = "_parse_${key}_attr";
293 if ( my $code = $self->can($meth) ) {
294 ( $key, $value ) = $self->$code( $c, $name, $value );
296 push( @{ $final_attributes{$key} }, $value );
300 return \%final_attributes;
303 sub _parse_Global_attr {
304 my ( $self, $c, $name, $value ) = @_;
305 return $self->_parse_Path_attr( $c, $name, "/$name" );
308 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
310 sub _parse_Local_attr {
311 my ( $self, $c, $name, $value ) = @_;
312 return $self->_parse_Path_attr( $c, $name, $name );
315 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
317 sub _parse_Path_attr {
318 my ( $self, $c, $name, $value ) = @_;
319 $value = '' if !defined $value;
320 if ( $value =~ m!^/! ) {
321 return ( 'Path', $value );
323 elsif ( length $value ) {
324 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
327 return ( 'Path', $self->path_prefix($c) );
331 sub _parse_Regex_attr {
332 my ( $self, $c, $name, $value ) = @_;
333 return ( 'Regex', $value );
336 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
338 sub _parse_LocalRegex_attr {
339 my ( $self, $c, $name, $value ) = @_;
340 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
342 my $prefix = $self->path_prefix( $c );
343 $prefix .= '/' if length( $prefix );
345 return ( 'Regex', "^${prefix}${value}" );
348 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
350 sub _parse_Chained_attr {
351 my ($self, $c, $name, $value) = @_;
353 if (defined($value) && length($value)) {
355 $value = '/'.$self->action_namespace($c);
356 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
357 my @parts = split '/', $self->action_namespace($c);
358 my @levels = split '/', $rel;
360 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
361 } elsif ($value !~ m/^\//) {
362 my $action_ns = $self->action_namespace($c);
365 $value = '/'.join('/', $action_ns, $value);
367 $value = '/'.$value; # special case namespace '' (root)
374 return Chained => $value;
377 sub _parse_ChainedParent_attr {
378 my ($self, $c, $name, $value) = @_;
379 return $self->_parse_Chained_attr($c, $name, '../'.$name);
382 sub _parse_PathPrefix_attr {
383 my ( $self, $c ) = @_;
384 return PathPart => $self->path_prefix($c);
387 sub _parse_ActionClass_attr {
388 my ( $self, $c, $name, $value ) = @_;
389 my $appname = $self->_application;
390 $value = Catalyst::Utils::resolve_namespace($appname . '::Action', $self->_action_class, $value);
391 return ( 'ActionClass', $value );
394 sub _parse_MyAction_attr {
395 my ( $self, $c, $name, $value ) = @_;
397 my $appclass = Catalyst::Utils::class2appclass($self);
398 $value = "${appclass}::Action::${value}";
400 return ( 'ActionClass', $value );
403 __PACKAGE__->meta->make_immutable;
411 Like any other L<Catalyst::Component>, controllers have a config hash,
412 accessible through $self->config from the controller actions. Some
413 settings are in use by the Catalyst framework:
417 This specifies the internal namespace the controller should be bound
418 to. By default the controller is bound to the URI version of the
419 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
420 will be bound to 'foo/bar'. The default Root controller is an example
421 of setting namespace to '' (the null string).
425 Sets 'path_prefix', as described below.
429 =head2 BUILDARGS ($app, @args)
431 From L<Catalyst::Component::ApplicationAttribute>, stashes the application
432 instance as $self->_application.
434 =head2 $self->action_for('name')
436 Returns the Catalyst::Action object (if any) for a given method name
439 =head2 $self->action_namespace($c)
441 Returns the private namespace for actions in this component. Defaults
442 to a value from the controller name (for
443 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
444 overridden from the "namespace" config key.
447 =head2 $self->path_prefix($c)
449 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
450 relative :Path actions in this component. Defaults to the action_namespace or
451 can be overridden from the "path" config key.
453 =head2 $self->register_actions($c)
455 Finds all applicable actions for this component, creates
456 Catalyst::Action objects (using $self->create_action) for them and
457 registers them with $c->dispatcher.
459 =head2 $self->get_action_methods()
461 Returns a list of L<Moose::Meta::Method> objects, doing the
462 L<MooseX::MethodAttributes::Role::Meta::Method> role, which are the set of
463 action methods for this package.
465 =head2 $self->register_action_methods($c, @methods)
467 Creates action objects for a set of action methods using C< create_action >,
468 and registers them with the dispatcher.
470 =head2 $self->create_action(%args)
472 Called with a hash of data to be use for construction of a new
473 Catalyst::Action (or appropriate sub/alternative class) object.
475 =head2 $self->_application
479 Returns the application instance stored by C<new()>
483 Catalyst Contributors, see Catalyst.pm
487 This library is free software. You can redistribute it and/or modify
488 it under the same terms as Perl itself.