1 package Catalyst::Controller;
3 #switch to BEGIN { extends qw/ ... /; } ?
4 use base qw/Catalyst::Component Catalyst::AttrContainer/;
7 use Class::MOP::Object ();
8 use Scalar::Util qw/blessed/;
9 use Catalyst::Exception;
12 with 'Catalyst::Component::Role::CaptureApp';
19 predicate => 'has_path_prefix',
22 has action_namespace =>
26 init_arg => 'namespace',
27 predicate => 'has_action_namespace',
38 my ($self, $args) = @_;
39 my $action = delete $args->{action} || {};
40 my $actions = delete $args->{actions} || {};
41 my $attr_value = $self->merge_config_hashes($actions, $action);
42 $self->actions($attr_value);
47 Catalyst::Controller - Catalyst Controller base class
51 package MyApp::Controller::Search
52 use base qw/Catalyst::Controller/;
55 my ($self,$c,@args) = @_;
57 } # Dispatches to /search/foo
61 Controllers are where the actions in the Catalyst framework
62 reside. Each action is represented by a function with an attribute to
63 identify what kind of action it is. See the L<Catalyst::Dispatcher>
64 for more info about how Catalyst dispatches to actions.
68 #I think both of these could be attributes. doesn't really seem like they need
69 #to ble class data. i think that attributes +default would work just fine
70 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
72 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
73 __PACKAGE__->_action_class('Catalyst::Action');
76 sub _DISPATCH : Private {
77 my ( $self, $c ) = @_;
79 foreach my $disp ( @{ $self->_dispatch_steps } ) {
80 last unless $c->forward($disp);
86 sub _BEGIN : Private {
87 my ( $self, $c ) = @_;
88 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
89 return 1 unless $begin;
90 $begin->dispatch( $c );
91 return !@{ $c->error };
95 my ( $self, $c ) = @_;
96 my @auto = $c->get_actions( 'auto', $c->namespace );
97 foreach my $auto (@auto) {
98 $auto->dispatch( $c );
99 return 0 unless $c->state;
104 sub _ACTION : Private {
105 my ( $self, $c ) = @_;
107 && $c->action->can('execute')
108 && defined $c->req->action )
110 $c->action->dispatch( $c );
112 return !@{ $c->error };
116 my ( $self, $c ) = @_;
117 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
118 return 1 unless $end;
119 $end->dispatch( $c );
120 return !@{ $c->error };
124 my ( $self, $name ) = @_;
125 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
126 return $app->dispatcher->get_action($name, $self->action_namespace);
129 #my opinion is that this whole sub really should be a builder method, not
130 #something that happens on every call. Anyone else disagree?? -- groditi
131 ## -- apparently this is all just waiting for app/ctx split
132 around action_namespace => sub {
134 my ( $self, $c ) = @_;
137 return $self->$orig if $self->has_action_namespace;
139 return $self->config->{namespace} if exists $self->config->{namespace};
144 $case_s = $c->config->{case_sensitive};
146 if ($self->isa('Catalyst')) {
147 $case_s = $self->config->{case_sensitive};
150 $case_s = $self->_application->config->{case_sensitive};
152 confess("Can't figure out case_sensitive setting");
157 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
158 $self->$orig($namespace) if ref($self);
162 #Once again, this is probably better written as a builder method
163 around path_prefix => sub {
167 return $self->$orig if $self->has_path_prefix;
169 return $self->config->{path} if exists $self->config->{path};
171 my $namespace = $self->action_namespace(@_);
172 $self->$orig($namespace) if ref($self);
177 sub register_actions {
178 my ( $self, $c ) = @_;
179 my $class = ref $self || $self;
180 #this is still not correct for some reason.
181 my $namespace = $self->action_namespace($c);
182 my $meta = $self->Class::MOP::Object::meta();
183 my %methods = map { $_->body => $_->name }
184 grep { $_->package_name ne 'Moose::Object' } #ignore Moose::Object methods
185 $meta->get_all_methods;
187 # Advanced inheritance support for plugins and the like
188 #moose todo: migrate to eliminate CDI compat
190 for my $isa ( $meta->superclasses, $class ) {
191 if(my $coderef = $isa->can('_action_cache')){
192 push(@action_cache, @{ $isa->$coderef });
196 foreach my $cache (@action_cache) {
197 my $code = $cache->[0];
198 my $method = delete $methods{$code}; # avoid dupe registers
200 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
201 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
202 $c->log->debug( 'Bad action definition "'
203 . join( ' ', @{ $cache->[1] } )
204 . qq/" for "$class->$method"/ )
208 my $reverse = $namespace ? "${namespace}/${method}" : $method;
209 my $action = $self->create_action(
213 namespace => $namespace,
215 attributes => $attrs,
218 $c->dispatcher->register( $c, $action );
226 my $class = (exists $args{attributes}{ActionClass}
227 ? $args{attributes}{ActionClass}[0]
228 : $self->_action_class);
230 Class::MOP::load_class($class);
231 return $class->new( \%args );
235 my ( $self, $c, $name, @attrs ) = @_;
239 foreach my $attr (@attrs) {
241 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
243 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
246 if ( defined $value ) {
247 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
249 push( @{ $raw_attributes{$key} }, $value );
253 #I know that the original behavior was to ignore action if actions was set
254 # but i actually think this may be a little more sane? we can always remove
255 # the merge behavior quite easily and go back to having actions have
256 # presedence over action by modifying the keys. i honestly think this is
257 # superior while mantaining really high degree of compat
260 $actions = $self->actions;
262 my $cfg = $self->config;
263 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
266 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
268 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
271 my %final_attributes;
273 foreach my $key (keys %raw_attributes) {
275 my $raw = $raw_attributes{$key};
277 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
279 my $meth = "_parse_${key}_attr";
280 if ( my $code = $self->can($meth) ) {
281 ( $key, $value ) = $self->$code( $c, $name, $value );
283 push( @{ $final_attributes{$key} }, $value );
287 return \%final_attributes;
290 sub _parse_Global_attr {
291 my ( $self, $c, $name, $value ) = @_;
292 return $self->_parse_Path_attr( $c, $name, "/$name" );
295 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
297 sub _parse_Local_attr {
298 my ( $self, $c, $name, $value ) = @_;
299 return $self->_parse_Path_attr( $c, $name, $name );
302 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
304 sub _parse_Path_attr {
305 my ( $self, $c, $name, $value ) = @_;
306 $value = '' if !defined $value;
307 if ( $value =~ m!^/! ) {
308 return ( 'Path', $value );
310 elsif ( length $value ) {
311 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
314 return ( 'Path', $self->path_prefix($c) );
318 sub _parse_Regex_attr {
319 my ( $self, $c, $name, $value ) = @_;
320 return ( 'Regex', $value );
323 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
325 sub _parse_LocalRegex_attr {
326 my ( $self, $c, $name, $value ) = @_;
327 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
329 my $prefix = $self->path_prefix( $c );
330 $prefix .= '/' if length( $prefix );
332 return ( 'Regex', "^${prefix}${value}" );
335 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
337 sub _parse_Chained_attr {
338 my ($self, $c, $name, $value) = @_;
340 if (defined($value) && length($value)) {
342 $value = '/'.$self->action_namespace($c);
343 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
344 my @parts = split '/', $self->action_namespace($c);
345 my @levels = split '/', $rel;
347 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
348 } elsif ($value !~ m/^\//) {
349 my $action_ns = $self->action_namespace($c);
352 $value = '/'.join('/', $action_ns, $value);
354 $value = '/'.$value; # special case namespace '' (root)
361 return Chained => $value;
364 sub _parse_ChainedParent_attr {
365 my ($self, $c, $name, $value) = @_;
366 return $self->_parse_Chained_attr($c, $name, '../'.$name);
369 sub _parse_PathPrefix_attr {
371 return PathPart => $self->path_prefix;
374 sub _parse_ActionClass_attr {
375 my ( $self, $c, $name, $value ) = @_;
376 unless ( $value =~ s/^\+// ) {
377 $value = join('::', $self->_action_class, $value );
379 return ( 'ActionClass', $value );
382 sub _parse_MyAction_attr {
383 my ( $self, $c, $name, $value ) = @_;
385 my $appclass = Catalyst::Utils::class2appclass($self);
386 $value = "${appclass}::Action::${value}";
388 return ( 'ActionClass', $value );
393 __PACKAGE__->meta->make_immutable;
401 Like any other L<Catalyst::Component>, controllers have a config hash,
402 accessible through $self->config from the controller actions. Some
403 settings are in use by the Catalyst framework:
407 This specifies the internal namespace the controller should be bound
408 to. By default the controller is bound to the URI version of the
409 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
410 will be bound to 'foo/bar'. The default Root controller is an example
411 of setting namespace to '' (the null string).
415 Sets 'path_prefix', as described below.
419 =head2 $class->new($app, @args)
421 Proxies through to NEXT::new and stashes the application instance as
424 =head2 $self->action_for('name')
426 Returns the Catalyst::Action object (if any) for a given method name
429 =head2 $self->register_actions($c)
431 Finds all applicable actions for this component, creates
432 Catalyst::Action objects (using $self->create_action) for them and
433 registers them with $c->dispatcher.
435 =head2 $self->action_namespace($c)
437 Returns the private namespace for actions in this component. Defaults
438 to a value from the controller name (for
439 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
440 overridden from the "namespace" config key.
443 =head2 $self->path_prefix($c)
445 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
446 relative :Path actions in this component. Defaults to the action_namespace or
447 can be overridden from the "path" config key.
449 =head2 $self->create_action(%args)
451 Called with a hash of data to be use for construction of a new
452 Catalyst::Action (or appropriate sub/alternative class) object.
454 Primarily designed for the use of register_actions.
456 =head2 $self->_application
460 Returns the application instance stored by C<new()>
464 Catalyst Contributors, see Catalyst.pm
468 This program is free software, you can redistribute it and/or modify
469 it under the same terms as Perl itself.