1 package Catalyst::Controller;
4 use Moose::Util qw/find_meta/;
6 use namespace::clean -except => 'meta';
8 # Note - Must be done at compile time due to attributes (::AttrContainer)
9 BEGIN { extends qw/Catalyst::Component Catalyst::AttrContainer/; }
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',
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->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(ref($self) || $self, $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);
179 sub register_actions {
180 my ( $self, $c ) = @_;
181 my $class = ref $self || $self;
182 #this is still not correct for some reason.
183 my $namespace = $self->action_namespace($c);
184 my $meta = find_meta($self);
185 my %methods = map { $_->body => $_->name }
186 $meta->get_all_methods;
188 # Advanced inheritance support for plugins and the like
189 #moose todo: migrate to eliminate CDI compat
191 for my $isa ( $meta->superclasses, $class ) {
192 if(my $coderef = $isa->can('_action_cache')){
193 push(@action_cache, @{ $isa->$coderef });
197 foreach my $cache (@action_cache) {
198 my $code = $cache->[0];
199 my $method = delete $methods{$code}; # avoid dupe registers
201 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
202 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
203 $c->log->debug( 'Bad action definition "'
204 . join( ' ', @{ $cache->[1] } )
205 . qq/" for "$class->$method"/ )
209 my $reverse = $namespace ? "${namespace}/${method}" : $method;
210 my $action = $self->create_action(
214 namespace => $namespace,
216 attributes => $attrs,
219 $c->dispatcher->register( $c, $action );
227 my $class = (exists $args{attributes}{ActionClass}
228 ? $args{attributes}{ActionClass}[0]
229 : $self->_action_class);
231 Class::MOP::load_class($class);
232 return $class->new( \%args );
236 my ( $self, $c, $name, @attrs ) = @_;
240 foreach my $attr (@attrs) {
242 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
244 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
247 if ( defined $value ) {
248 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
250 push( @{ $raw_attributes{$key} }, $value );
254 #I know that the original behavior was to ignore action if actions was set
255 # but i actually think this may be a little more sane? we can always remove
256 # the merge behavior quite easily and go back to having actions have
257 # presedence over action by modifying the keys. i honestly think this is
258 # superior while mantaining really high degree of compat
261 $actions = $self->actions;
263 my $cfg = $self->config;
264 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
267 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
269 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
272 my %final_attributes;
274 foreach my $key (keys %raw_attributes) {
276 my $raw = $raw_attributes{$key};
278 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
280 my $meth = "_parse_${key}_attr";
281 if ( my $code = $self->can($meth) ) {
282 ( $key, $value ) = $self->$code( $c, $name, $value );
284 push( @{ $final_attributes{$key} }, $value );
288 return \%final_attributes;
291 sub _parse_Global_attr {
292 my ( $self, $c, $name, $value ) = @_;
293 return $self->_parse_Path_attr( $c, $name, "/$name" );
296 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
298 sub _parse_Local_attr {
299 my ( $self, $c, $name, $value ) = @_;
300 return $self->_parse_Path_attr( $c, $name, $name );
303 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
305 sub _parse_Path_attr {
306 my ( $self, $c, $name, $value ) = @_;
307 $value = '' if !defined $value;
308 if ( $value =~ m!^/! ) {
309 return ( 'Path', $value );
311 elsif ( length $value ) {
312 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
315 return ( 'Path', $self->path_prefix($c) );
319 sub _parse_Regex_attr {
320 my ( $self, $c, $name, $value ) = @_;
321 return ( 'Regex', $value );
324 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
326 sub _parse_LocalRegex_attr {
327 my ( $self, $c, $name, $value ) = @_;
328 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
330 my $prefix = $self->path_prefix( $c );
331 $prefix .= '/' if length( $prefix );
333 return ( 'Regex', "^${prefix}${value}" );
336 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
338 sub _parse_Chained_attr {
339 my ($self, $c, $name, $value) = @_;
341 if (defined($value) && length($value)) {
343 $value = '/'.$self->action_namespace($c);
344 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
345 my @parts = split '/', $self->action_namespace($c);
346 my @levels = split '/', $rel;
348 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
349 } elsif ($value !~ m/^\//) {
350 my $action_ns = $self->action_namespace($c);
353 $value = '/'.join('/', $action_ns, $value);
355 $value = '/'.$value; # special case namespace '' (root)
362 return Chained => $value;
365 sub _parse_ChainedParent_attr {
366 my ($self, $c, $name, $value) = @_;
367 return $self->_parse_Chained_attr($c, $name, '../'.$name);
370 sub _parse_PathPrefix_attr {
372 return PathPart => $self->path_prefix;
375 sub _parse_ActionClass_attr {
376 my ( $self, $c, $name, $value ) = @_;
377 unless ( $value =~ s/^\+// ) {
378 $value = join('::', $self->_action_class, $value );
380 return ( 'ActionClass', $value );
383 sub _parse_MyAction_attr {
384 my ( $self, $c, $name, $value ) = @_;
386 my $appclass = Catalyst::Utils::class2appclass($self);
387 $value = "${appclass}::Action::${value}";
389 return ( 'ActionClass', $value );
392 __PACKAGE__->meta->make_immutable;
400 Like any other L<Catalyst::Component>, controllers have a config hash,
401 accessible through $self->config from the controller actions. Some
402 settings are in use by the Catalyst framework:
406 This specifies the internal namespace the controller should be bound
407 to. By default the controller is bound to the URI version of the
408 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
409 will be bound to 'foo/bar'. The default Root controller is an example
410 of setting namespace to '' (the null string).
414 Sets 'path_prefix', as described below.
418 =head2 $class->new($app, @args)
420 Proxies through to NEXT::new and stashes the application instance as
423 =head2 $self->action_for('name')
425 Returns the Catalyst::Action object (if any) for a given method name
428 =head2 $self->register_actions($c)
430 Finds all applicable actions for this component, creates
431 Catalyst::Action objects (using $self->create_action) for them and
432 registers them with $c->dispatcher.
434 =head2 $self->action_namespace($c)
436 Returns the private namespace for actions in this component. Defaults
437 to a value from the controller name (for
438 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
439 overridden from the "namespace" config key.
442 =head2 $self->path_prefix($c)
444 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
445 relative :Path actions in this component. Defaults to the action_namespace or
446 can be overridden from the "path" config key.
448 =head2 $self->create_action(%args)
450 Called with a hash of data to be use for construction of a new
451 Catalyst::Action (or appropriate sub/alternative class) object.
453 Primarily designed for the use of register_actions.
455 =head2 $self->_application
459 Returns the application instance stored by C<new()>
463 Catalyst Contributors, see Catalyst.pm
467 This program is free software, you can redistribute it and/or modify
468 it under the same terms as Perl itself.