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);
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 ) = @_;
141 return $self->$orig if $self->has_action_namespace;
143 return $self->config->{namespace} if exists $self->config->{namespace};
148 $case_s = $c->config->{case_sensitive};
150 if ($self->isa('Catalyst')) {
151 $case_s = $self->config->{case_sensitive};
154 $case_s = $self->_application->config->{case_sensitive};
156 confess("Can't figure out case_sensitive setting");
161 my $namespace = Catalyst::Utils::class2prefix($self->catalyst_component_name, $case_s) || '';
162 $self->$orig($namespace) if ref($self);
166 #Once again, this is probably better written as a builder method
167 around path_prefix => sub {
171 return $self->$orig if $self->has_path_prefix;
173 return $self->config->{path} if exists $self->config->{path};
175 my $namespace = $self->action_namespace(@_);
176 $self->$orig($namespace) if ref($self);
180 sub get_action_methods {
182 my $meta = find_meta($self) || confess("No metaclass setup for $self");
184 . ref($meta) . " for "
186 . " cannot support register_actions." )
187 unless $meta->can('get_nearest_methods_with_attributes');
188 my @methods = $meta->get_nearest_methods_with_attributes;
190 # actions specified via config are also action_methods
194 $meta->find_method_by_name($_)
195 || confess( 'Action "'
197 . '" is not available from controller '
199 } keys %{ $self->_controller_actions }
205 sub register_actions {
206 my ( $self, $c ) = @_;
207 $self->register_action_methods( $c, $self->get_action_methods );
210 sub register_action_methods {
211 my ( $self, $c, @methods ) = @_;
212 my $class = $self->catalyst_component_name;
213 #this is still not correct for some reason.
214 my $namespace = $self->action_namespace($c);
216 # Uncomment as soon as you fix the tests :)
217 #if (!blessed($self) && $self eq $c && scalar(@methods)) {
218 # $c->log->warn("Action methods found defined in your application class, $self. This is deprecated, please move them into a Root controller.");
221 foreach my $method (@methods) {
222 my $name = $method->name;
223 my $attributes = $method->attributes;
224 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
225 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
226 $c->log->debug( 'Bad action definition "'
227 . join( ' ', @{ $attributes } )
228 . qq/" for "$class->$name"/ )
232 my $reverse = $namespace ? "${namespace}/${name}" : $name;
233 my $action = $self->create_action(
235 code => $method->body,
237 namespace => $namespace,
239 attributes => $attrs,
242 $c->dispatcher->register( $c, $action );
250 my $class = (exists $args{attributes}{ActionClass}
251 ? $args{attributes}{ActionClass}[0]
252 : $self->_action_class);
254 Class::MOP::load_class($class);
255 return $class->new( \%args );
259 my ( $self, $c, $name, @attrs ) = @_;
263 foreach my $attr (@attrs) {
265 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
267 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
270 if ( defined $value ) {
271 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
273 push( @{ $raw_attributes{$key} }, $value );
277 #I know that the original behavior was to ignore action if actions was set
278 # but i actually think this may be a little more sane? we can always remove
279 # the merge behavior quite easily and go back to having actions have
280 # presedence over action by modifying the keys. i honestly think this is
281 # superior while mantaining really high degree of compat
284 $actions = $self->_controller_actions;
286 my $cfg = $self->config;
287 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
290 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
292 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
295 my %final_attributes;
297 foreach my $key (keys %raw_attributes) {
299 my $raw = $raw_attributes{$key};
301 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
303 my $meth = "_parse_${key}_attr";
304 if ( my $code = $self->can($meth) ) {
305 ( $key, $value ) = $self->$code( $c, $name, $value );
307 push( @{ $final_attributes{$key} }, $value );
311 return \%final_attributes;
314 sub _parse_Global_attr {
315 my ( $self, $c, $name, $value ) = @_;
316 return $self->_parse_Path_attr( $c, $name, "/$name" );
319 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
321 sub _parse_Local_attr {
322 my ( $self, $c, $name, $value ) = @_;
323 return $self->_parse_Path_attr( $c, $name, $name );
326 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
328 sub _parse_Path_attr {
329 my ( $self, $c, $name, $value ) = @_;
330 $value = '' if !defined $value;
331 if ( $value =~ m!^/! ) {
332 return ( 'Path', $value );
334 elsif ( length $value ) {
335 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
338 return ( 'Path', $self->path_prefix($c) );
342 sub _parse_Regex_attr {
343 my ( $self, $c, $name, $value ) = @_;
344 return ( 'Regex', $value );
347 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
349 sub _parse_LocalRegex_attr {
350 my ( $self, $c, $name, $value ) = @_;
351 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
353 my $prefix = $self->path_prefix( $c );
354 $prefix .= '/' if length( $prefix );
356 return ( 'Regex', "^${prefix}${value}" );
359 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
361 sub _parse_Chained_attr {
362 my ($self, $c, $name, $value) = @_;
364 if (defined($value) && length($value)) {
366 $value = '/'.$self->action_namespace($c);
367 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
368 my @parts = split '/', $self->action_namespace($c);
369 my @levels = split '/', $rel;
371 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
372 } elsif ($value !~ m/^\//) {
373 my $action_ns = $self->action_namespace($c);
376 $value = '/'.join('/', $action_ns, $value);
378 $value = '/'.$value; # special case namespace '' (root)
385 return Chained => $value;
388 sub _parse_ChainedParent_attr {
389 my ($self, $c, $name, $value) = @_;
390 return $self->_parse_Chained_attr($c, $name, '../'.$name);
393 sub _parse_PathPrefix_attr {
394 my ( $self, $c ) = @_;
395 return PathPart => $self->path_prefix($c);
398 sub _parse_ActionClass_attr {
399 my ( $self, $c, $name, $value ) = @_;
400 my $appname = $self->_application;
401 $value = Catalyst::Utils::resolve_namespace($appname . '::Action', $self->_action_class, $value);
402 return ( 'ActionClass', $value );
405 sub _parse_MyAction_attr {
406 my ( $self, $c, $name, $value ) = @_;
408 my $appclass = Catalyst::Utils::class2appclass($self);
409 $value = "${appclass}::Action::${value}";
411 return ( 'ActionClass', $value );
414 __PACKAGE__->meta->make_immutable;
422 Like any other L<Catalyst::Component>, controllers have a config hash,
423 accessible through $self->config from the controller actions. Some
424 settings are in use by the Catalyst framework:
428 This specifies the internal namespace the controller should be bound
429 to. By default the controller is bound to the URI version of the
430 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
431 will be bound to 'foo/bar'. The default Root controller is an example
432 of setting namespace to '' (the null string).
436 Sets 'path_prefix', as described below.
440 =head2 BUILDARGS ($app, @args)
442 From L<Catalyst::Component::ApplicationAttribute>, stashes the application
443 instance as $self->_application.
445 =head2 $self->action_for('name')
447 Returns the Catalyst::Action object (if any) for a given method name
450 =head2 $self->action_namespace($c)
452 Returns the private namespace for actions in this component. Defaults
453 to a value from the controller name (for
454 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
455 overridden from the "namespace" config key.
458 =head2 $self->path_prefix($c)
460 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
461 relative :Path actions in this component. Defaults to the action_namespace or
462 can be overridden from the "path" config key.
464 =head2 $self->register_actions($c)
466 Finds all applicable actions for this component, creates
467 Catalyst::Action objects (using $self->create_action) for them and
468 registers them with $c->dispatcher.
470 =head2 $self->get_action_methods()
472 Returns a list of L<Moose::Meta::Method> objects, doing the
473 L<MooseX::MethodAttributes::Role::Meta::Method> role, which are the set of
474 action methods for this package.
476 =head2 $self->register_action_methods($c, @methods)
478 Creates action objects for a set of action methods using C< create_action >,
479 and registers them with the dispatcher.
481 =head2 $self->create_action(%args)
483 Called with a hash of data to be use for construction of a new
484 Catalyst::Action (or appropriate sub/alternative class) object.
486 =head2 $self->_application
490 Returns the application instance stored by C<new()>
494 Catalyst Contributors, see Catalyst.pm
498 This library is free software. You can redistribute it and/or modify
499 it under the same terms as Perl itself.