1 package Catalyst::Controller;
4 use Moose::Util qw/find_meta/;
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',
32 has _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);
49 Catalyst::Controller - Catalyst Controller base class
53 package MyApp::Controller::Search
54 use base qw/Catalyst::Controller/;
57 my ($self,$c,@args) = @_;
59 } # Dispatches to /search/foo
63 Controllers are where the actions in the Catalyst framework
64 reside. Each action is represented by a function with an attribute to
65 identify what kind of action it is. See the L<Catalyst::Dispatcher>
66 for more info about how Catalyst dispatches to actions.
70 #I think both of these could be attributes. doesn't really seem like they need
71 #to ble class data. i think that attributes +default would work just fine
72 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
74 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
75 __PACKAGE__->_action_class('Catalyst::Action');
78 sub _DISPATCH : Private {
79 my ( $self, $c ) = @_;
81 foreach my $disp ( @{ $self->_dispatch_steps } ) {
82 last unless $c->forward($disp);
88 sub _BEGIN : Private {
89 my ( $self, $c ) = @_;
90 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
91 return 1 unless $begin;
92 $begin->dispatch( $c );
93 return !@{ $c->error };
97 my ( $self, $c ) = @_;
98 my @auto = $c->get_actions( 'auto', $c->namespace );
99 foreach my $auto (@auto) {
100 $auto->dispatch( $c );
101 return 0 unless $c->state;
106 sub _ACTION : Private {
107 my ( $self, $c ) = @_;
109 && $c->action->can('execute')
110 && defined $c->req->action )
112 $c->action->dispatch( $c );
114 return !@{ $c->error };
118 my ( $self, $c ) = @_;
119 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
120 return 1 unless $end;
121 $end->dispatch( $c );
122 return !@{ $c->error };
126 my ( $self, $name ) = @_;
127 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
128 return $app->dispatcher->get_action($name, $self->action_namespace);
131 #my opinion is that this whole sub really should be a builder method, not
132 #something that happens on every call. Anyone else disagree?? -- groditi
133 ## -- apparently this is all just waiting for app/ctx split
134 around action_namespace => sub {
136 my ( $self, $c ) = @_;
139 return $self->$orig if $self->has_action_namespace;
141 return $self->config->{namespace} if exists $self->config->{namespace};
146 $case_s = $c->config->{case_sensitive};
148 if ($self->isa('Catalyst')) {
149 $case_s = $self->config->{case_sensitive};
152 $case_s = $self->_application->config->{case_sensitive};
154 confess("Can't figure out case_sensitive setting");
159 my $namespace = Catalyst::Utils::class2prefix($self->_component_name, $case_s) || '';
160 $self->$orig($namespace) if ref($self);
164 #Once again, this is probably better written as a builder method
165 around path_prefix => sub {
169 return $self->$orig if $self->has_path_prefix;
171 return $self->config->{path} if exists $self->config->{path};
173 my $namespace = $self->action_namespace(@_);
174 $self->$orig($namespace) if ref($self);
178 sub get_action_methods {
180 my $meta = find_meta($self);
181 confess("Metaclass for "
182 . ref($meta) . " for "
184 . " cannot support register_actions." )
185 unless $meta->can('get_nearest_methods_with_attributes');
186 my @methods = $meta->get_nearest_methods_with_attributes;
188 # actions specified via config are also action_methods
192 $meta->find_method_by_name($_)
193 || confess( 'Action "'
195 . '" is not available from controller '
197 } keys %{ $self->_controller_actions }
203 sub register_actions {
204 my ( $self, $c ) = @_;
205 $self->register_action_methods( $c, $self->get_action_methods );
208 sub register_action_methods {
209 my ( $self, $c, @methods ) = @_;
210 my $class = $self->_component_name;
211 #this is still not correct for some reason.
212 my $namespace = $self->action_namespace($c);
214 # Uncomment as soon as you fix the tests :)
215 #if (!blessed($self) && $self eq $c && scalar(@methods)) {
216 # $c->log->warn("Action methods found defined in your application class, $self. This is deprecated, please move them into a Root controller.");
219 foreach my $method (@methods) {
220 my $name = $method->name;
221 my $attributes = $method->attributes;
222 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
223 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
224 $c->log->debug( 'Bad action definition "'
225 . join( ' ', @{ $attributes } )
226 . qq/" for "$class->$name"/ )
230 my $reverse = $namespace ? "${namespace}/${name}" : $name;
231 my $action = $self->create_action(
233 code => $method->body,
235 namespace => $namespace,
237 attributes => $attrs,
240 $c->dispatcher->register( $c, $action );
248 my $class = (exists $args{attributes}{ActionClass}
249 ? $args{attributes}{ActionClass}[0]
250 : $self->_action_class);
252 Class::MOP::load_class($class);
253 return $class->new( \%args );
257 my ( $self, $c, $name, @attrs ) = @_;
261 foreach my $attr (@attrs) {
263 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
265 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
268 if ( defined $value ) {
269 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
271 push( @{ $raw_attributes{$key} }, $value );
275 #I know that the original behavior was to ignore action if actions was set
276 # but i actually think this may be a little more sane? we can always remove
277 # the merge behavior quite easily and go back to having actions have
278 # presedence over action by modifying the keys. i honestly think this is
279 # superior while mantaining really high degree of compat
282 $actions = $self->_controller_actions;
284 my $cfg = $self->config;
285 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
288 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
290 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
293 my %final_attributes;
295 foreach my $key (keys %raw_attributes) {
297 my $raw = $raw_attributes{$key};
299 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
301 my $meth = "_parse_${key}_attr";
302 if ( my $code = $self->can($meth) ) {
303 ( $key, $value ) = $self->$code( $c, $name, $value );
305 push( @{ $final_attributes{$key} }, $value );
309 return \%final_attributes;
312 sub _parse_Global_attr {
313 my ( $self, $c, $name, $value ) = @_;
314 return $self->_parse_Path_attr( $c, $name, "/$name" );
317 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
319 sub _parse_Local_attr {
320 my ( $self, $c, $name, $value ) = @_;
321 return $self->_parse_Path_attr( $c, $name, $name );
324 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
326 sub _parse_Path_attr {
327 my ( $self, $c, $name, $value ) = @_;
328 $value = '' if !defined $value;
329 if ( $value =~ m!^/! ) {
330 return ( 'Path', $value );
332 elsif ( length $value ) {
333 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
336 return ( 'Path', $self->path_prefix($c) );
340 sub _parse_Regex_attr {
341 my ( $self, $c, $name, $value ) = @_;
342 return ( 'Regex', $value );
345 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
347 sub _parse_LocalRegex_attr {
348 my ( $self, $c, $name, $value ) = @_;
349 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
351 my $prefix = $self->path_prefix( $c );
352 $prefix .= '/' if length( $prefix );
354 return ( 'Regex', "^${prefix}${value}" );
357 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
359 sub _parse_Chained_attr {
360 my ($self, $c, $name, $value) = @_;
362 if (defined($value) && length($value)) {
364 $value = '/'.$self->action_namespace($c);
365 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
366 my @parts = split '/', $self->action_namespace($c);
367 my @levels = split '/', $rel;
369 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
370 } elsif ($value !~ m/^\//) {
371 my $action_ns = $self->action_namespace($c);
374 $value = '/'.join('/', $action_ns, $value);
376 $value = '/'.$value; # special case namespace '' (root)
383 return Chained => $value;
386 sub _parse_ChainedParent_attr {
387 my ($self, $c, $name, $value) = @_;
388 return $self->_parse_Chained_attr($c, $name, '../'.$name);
391 sub _parse_PathPrefix_attr {
392 my ( $self, $c ) = @_;
393 return PathPart => $self->path_prefix($c);
396 sub _parse_ActionClass_attr {
397 my ( $self, $c, $name, $value ) = @_;
398 my $appname = $self->_application;
399 $value = Catalyst::Utils::resolve_namespace($appname . '::Action', $self->_action_class, $value);
400 return ( 'ActionClass', $value );
403 sub _parse_MyAction_attr {
404 my ( $self, $c, $name, $value ) = @_;
406 my $appclass = Catalyst::Utils::class2appclass($self);
407 $value = "${appclass}::Action::${value}";
409 return ( 'ActionClass', $value );
412 __PACKAGE__->meta->make_immutable;
420 Like any other L<Catalyst::Component>, controllers have a config hash,
421 accessible through $self->config from the controller actions. Some
422 settings are in use by the Catalyst framework:
426 This specifies the internal namespace the controller should be bound
427 to. By default the controller is bound to the URI version of the
428 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
429 will be bound to 'foo/bar'. The default Root controller is an example
430 of setting namespace to '' (the null string).
434 Sets 'path_prefix', as described below.
438 =head2 BUILDARGS ($app, @args)
440 From L<Catalyst::Component::ApplicationAttribute>, stashes the application
441 instance as $self->_application.
443 =head2 $self->action_for('name')
445 Returns the Catalyst::Action object (if any) for a given method name
448 =head2 $self->action_namespace($c)
450 Returns the private namespace for actions in this component. Defaults
451 to a value from the controller name (for
452 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
453 overridden from the "namespace" config key.
456 =head2 $self->path_prefix($c)
458 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
459 relative :Path actions in this component. Defaults to the action_namespace or
460 can be overridden from the "path" config key.
462 =head2 $self->register_actions($c)
464 Finds all applicable actions for this component, creates
465 Catalyst::Action objects (using $self->create_action) for them and
466 registers them with $c->dispatcher.
468 =head2 $self->get_action_methods()
470 Returns a list of L<Moose::Meta::Method> objects, doing the
471 L<MooseX::MethodAttributes::Role::Meta::Method> role, which are the set of
472 action methods for this package.
474 =head2 $self->register_action_methods($c, @methods)
476 Creates action objects for a set of action methods using C< create_action >,
477 and registers them with the dispatcher.
479 =head2 $self->create_action(%args)
481 Called with a hash of data to be use for construction of a new
482 Catalyst::Action (or appropriate sub/alternative class) object.
484 =head2 $self->_application
488 Returns the application instance stored by C<new()>
492 Catalyst Contributors, see Catalyst.pm
496 This library is free software. You can redistribute it and/or modify
497 it under the same terms as Perl itself.