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 ) = @_;
140 my $class = ref($self) || $self;
141 my $appclass = ref($c) || $c;
143 return $self->$orig if $self->has_action_namespace;
145 return $class->config->{namespace} if exists $class->config->{namespace};
150 $case_s = $appclass->config->{case_sensitive};
152 if ($self->isa('Catalyst')) {
153 $case_s = $class->config->{case_sensitive};
156 $case_s = ref($self->_application)->config->{case_sensitive};
158 confess("Can't figure out case_sensitive setting");
163 my $namespace = Catalyst::Utils::class2prefix($self->catalyst_component_name, $case_s) || '';
164 $self->$orig($namespace) if ref($self);
168 #Once again, this is probably better written as a builder method
169 around path_prefix => sub {
173 return $self->$orig if $self->has_path_prefix;
175 return $self->config->{path} if exists $self->config->{path};
177 my $namespace = $self->action_namespace(@_);
178 $self->$orig($namespace) if ref($self);
182 sub get_action_methods {
184 my $meta = find_meta($self) || confess("No metaclass setup for $self");
186 . ref($meta) . " for "
188 . " cannot support register_actions." )
189 unless $meta->can('get_nearest_methods_with_attributes');
190 my @methods = $meta->get_nearest_methods_with_attributes;
192 # actions specified via config are also action_methods
196 $meta->find_method_by_name($_)
197 || confess( 'Action "'
199 . '" is not available from controller '
201 } keys %{ $self->_controller_actions }
207 sub register_actions {
208 my ( $self, $c ) = @_;
209 $self->register_action_methods( $c, $self->get_action_methods );
212 sub register_action_methods {
213 my ( $self, $c, @methods ) = @_;
214 my $class = $self->catalyst_component_name;
215 #this is still not correct for some reason.
216 my $namespace = $self->action_namespace($c);
218 # Uncomment as soon as you fix the tests :)
219 #if (!blessed($self) && $self eq $c && scalar(@methods)) {
220 # $c->log->warn("Action methods found defined in your application class, $self. This is deprecated, please move them into a Root controller.");
223 foreach my $method (@methods) {
224 my $name = $method->name;
225 my $attributes = $method->attributes;
226 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
227 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
228 $c->log->debug( 'Bad action definition "'
229 . join( ' ', @{ $attributes } )
230 . qq/" for "$class->$name"/ )
234 my $reverse = $namespace ? "${namespace}/${name}" : $name;
235 my $action = $self->create_action(
237 code => $method->body,
239 namespace => $namespace,
241 attributes => $attrs,
244 $c->dispatcher->register( $c, $action );
252 my $class = (exists $args{attributes}{ActionClass}
253 ? $args{attributes}{ActionClass}[0]
254 : $self->_action_class);
256 Class::MOP::load_class($class);
257 return $class->new( \%args );
261 my ( $self, $c, $name, @attrs ) = @_;
265 foreach my $attr (@attrs) {
267 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
269 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
272 if ( defined $value ) {
273 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
275 push( @{ $raw_attributes{$key} }, $value );
279 #I know that the original behavior was to ignore action if actions was set
280 # but i actually think this may be a little more sane? we can always remove
281 # the merge behavior quite easily and go back to having actions have
282 # presedence over action by modifying the keys. i honestly think this is
283 # superior while mantaining really high degree of compat
286 $actions = $self->_controller_actions;
288 my $cfg = $self->config;
289 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
292 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
294 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
297 my %final_attributes;
299 foreach my $key (keys %raw_attributes) {
301 my $raw = $raw_attributes{$key};
303 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
305 my $meth = "_parse_${key}_attr";
306 if ( my $code = $self->can($meth) ) {
307 ( $key, $value ) = $self->$code( $c, $name, $value );
309 push( @{ $final_attributes{$key} }, $value );
313 return \%final_attributes;
316 sub _parse_Global_attr {
317 my ( $self, $c, $name, $value ) = @_;
318 return $self->_parse_Path_attr( $c, $name, "/$name" );
321 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
323 sub _parse_Local_attr {
324 my ( $self, $c, $name, $value ) = @_;
325 return $self->_parse_Path_attr( $c, $name, $name );
328 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
330 sub _parse_Path_attr {
331 my ( $self, $c, $name, $value ) = @_;
332 $value = '' if !defined $value;
333 if ( $value =~ m!^/! ) {
334 return ( 'Path', $value );
336 elsif ( length $value ) {
337 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
340 return ( 'Path', $self->path_prefix($c) );
344 sub _parse_Regex_attr {
345 my ( $self, $c, $name, $value ) = @_;
346 return ( 'Regex', $value );
349 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
351 sub _parse_LocalRegex_attr {
352 my ( $self, $c, $name, $value ) = @_;
353 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
355 my $prefix = $self->path_prefix( $c );
356 $prefix .= '/' if length( $prefix );
358 return ( 'Regex', "^${prefix}${value}" );
361 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
363 sub _parse_Chained_attr {
364 my ($self, $c, $name, $value) = @_;
366 if (defined($value) && length($value)) {
368 $value = '/'.$self->action_namespace($c);
369 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
370 my @parts = split '/', $self->action_namespace($c);
371 my @levels = split '/', $rel;
373 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
374 } elsif ($value !~ m/^\//) {
375 my $action_ns = $self->action_namespace($c);
378 $value = '/'.join('/', $action_ns, $value);
380 $value = '/'.$value; # special case namespace '' (root)
387 return Chained => $value;
390 sub _parse_ChainedParent_attr {
391 my ($self, $c, $name, $value) = @_;
392 return $self->_parse_Chained_attr($c, $name, '../'.$name);
395 sub _parse_PathPrefix_attr {
396 my ( $self, $c ) = @_;
397 return PathPart => $self->path_prefix($c);
400 sub _parse_ActionClass_attr {
401 my ( $self, $c, $name, $value ) = @_;
402 my $appname = $self->_application;
403 $value = Catalyst::Utils::resolve_namespace($appname . '::Action', $self->_action_class, $value);
404 return ( 'ActionClass', $value );
407 sub _parse_MyAction_attr {
408 my ( $self, $c, $name, $value ) = @_;
410 my $appclass = Catalyst::Utils::class2appclass($self);
411 $value = "${appclass}::Action::${value}";
413 return ( 'ActionClass', $value );
416 __PACKAGE__->meta->make_immutable;
424 Like any other L<Catalyst::Component>, controllers have a config hash,
425 accessible through $self->config from the controller actions. Some
426 settings are in use by the Catalyst framework:
430 This specifies the internal namespace the controller should be bound
431 to. By default the controller is bound to the URI version of the
432 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
433 will be bound to 'foo/bar'. The default Root controller is an example
434 of setting namespace to '' (the null string).
438 Sets 'path_prefix', as described below.
442 =head2 BUILDARGS ($app, @args)
444 From L<Catalyst::Component::ApplicationAttribute>, stashes the application
445 instance as $self->_application.
447 =head2 $self->action_for('name')
449 Returns the Catalyst::Action object (if any) for a given method name
452 =head2 $self->action_namespace($c)
454 Returns the private namespace for actions in this component. Defaults
455 to a value from the controller name (for
456 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
457 overridden from the "namespace" config key.
460 =head2 $self->path_prefix($c)
462 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
463 relative :Path actions in this component. Defaults to the action_namespace or
464 can be overridden from the "path" config key.
466 =head2 $self->register_actions($c)
468 Finds all applicable actions for this component, creates
469 Catalyst::Action objects (using $self->create_action) for them and
470 registers them with $c->dispatcher.
472 =head2 $self->get_action_methods()
474 Returns a list of L<Moose::Meta::Method> objects, doing the
475 L<MooseX::MethodAttributes::Role::Meta::Method> role, which are the set of
476 action methods for this package.
478 =head2 $self->register_action_methods($c, @methods)
480 Creates action objects for a set of action methods using C< create_action >,
481 and registers them with the dispatcher.
483 =head2 $self->create_action(%args)
485 Called with a hash of data to be use for construction of a new
486 Catalyst::Action (or appropriate sub/alternative class) object.
488 =head2 $self->_application
492 Returns the application instance stored by C<new()>
496 Catalyst Contributors, see Catalyst.pm
500 This library is free software. You can redistribute it and/or modify
501 it under the same terms as Perl itself.