1 package Catalyst::Controller;
4 # Note - Must be done at compile time due to attributes (::AttrContainer)
5 BEGIN { extends qw/Catalyst::Component Catalyst::AttrContainer/; }
7 use Class::MOP::Object ();
8 use Catalyst::Exception;
11 with 'Catalyst::Component::ApplicationAttribute';
18 predicate => 'has_path_prefix',
21 has action_namespace =>
25 init_arg => 'namespace',
26 predicate => 'has_action_namespace',
37 my ($self, $args) = @_;
38 my $action = delete $args->{action} || {};
39 my $actions = delete $args->{actions} || {};
40 my $attr_value = $self->merge_config_hashes($actions, $action);
41 $self->actions($attr_value);
46 Catalyst::Controller - Catalyst Controller base class
50 package MyApp::Controller::Search
51 use base qw/Catalyst::Controller/;
54 my ($self,$c,@args) = @_;
56 } # Dispatches to /search/foo
60 Controllers are where the actions in the Catalyst framework
61 reside. Each action is represented by a function with an attribute to
62 identify what kind of action it is. See the L<Catalyst::Dispatcher>
63 for more info about how Catalyst dispatches to actions.
67 #I think both of these could be attributes. doesn't really seem like they need
68 #to ble class data. i think that attributes +default would work just fine
69 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
71 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
72 __PACKAGE__->_action_class('Catalyst::Action');
75 sub _DISPATCH : Private {
76 my ( $self, $c ) = @_;
78 foreach my $disp ( @{ $self->_dispatch_steps } ) {
79 last unless $c->forward($disp);
85 sub _BEGIN : Private {
86 my ( $self, $c ) = @_;
87 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
88 return 1 unless $begin;
89 $begin->dispatch( $c );
90 return !@{ $c->error };
94 my ( $self, $c ) = @_;
95 my @auto = $c->get_actions( 'auto', $c->namespace );
96 foreach my $auto (@auto) {
97 $auto->dispatch( $c );
98 return 0 unless $c->state;
103 sub _ACTION : Private {
104 my ( $self, $c ) = @_;
106 && $c->action->can('execute')
107 && defined $c->req->action )
109 $c->action->dispatch( $c );
111 return !@{ $c->error };
115 my ( $self, $c ) = @_;
116 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
117 return 1 unless $end;
118 $end->dispatch( $c );
119 return !@{ $c->error };
123 my ( $self, $name ) = @_;
124 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
125 return $app->dispatcher->get_action($name, $self->action_namespace);
128 #my opinion is that this whole sub really should be a builder method, not
129 #something that happens on every call. Anyone else disagree?? -- groditi
130 ## -- apparently this is all just waiting for app/ctx split
131 around action_namespace => sub {
133 my ( $self, $c ) = @_;
136 return $self->$orig if $self->has_action_namespace;
138 return $self->config->{namespace} if exists $self->config->{namespace};
143 $case_s = $c->config->{case_sensitive};
145 if ($self->isa('Catalyst')) {
146 $case_s = $self->config->{case_sensitive};
149 $case_s = $self->_application->config->{case_sensitive};
151 confess("Can't figure out case_sensitive setting");
156 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
157 $self->$orig($namespace) if ref($self);
161 #Once again, this is probably better written as a builder method
162 around path_prefix => sub {
166 return $self->$orig if $self->has_path_prefix;
168 return $self->config->{path} if exists $self->config->{path};
170 my $namespace = $self->action_namespace(@_);
171 $self->$orig($namespace) if ref($self);
176 sub register_actions {
177 my ( $self, $c ) = @_;
178 my $class = ref $self || $self;
179 #this is still not correct for some reason.
180 my $namespace = $self->action_namespace($c);
181 my $meta = $self->Class::MOP::Object::meta();
182 my %methods = map { $_->body => $_->name }
183 grep { $_->package_name ne 'Moose::Object' } #ignore Moose::Object methods
184 $meta->get_all_methods;
186 # Advanced inheritance support for plugins and the like
187 #moose todo: migrate to eliminate CDI compat
189 for my $isa ( $meta->superclasses, $class ) {
190 if(my $coderef = $isa->can('_action_cache')){
191 push(@action_cache, @{ $isa->$coderef });
195 foreach my $cache (@action_cache) {
196 my $code = $cache->[0];
197 my $method = delete $methods{$code}; # avoid dupe registers
199 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
200 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
201 $c->log->debug( 'Bad action definition "'
202 . join( ' ', @{ $cache->[1] } )
203 . qq/" for "$class->$method"/ )
207 my $reverse = $namespace ? "${namespace}/${method}" : $method;
208 my $action = $self->create_action(
212 namespace => $namespace,
214 attributes => $attrs,
217 $c->dispatcher->register( $c, $action );
225 my $class = (exists $args{attributes}{ActionClass}
226 ? $args{attributes}{ActionClass}[0]
227 : $self->_action_class);
229 Class::MOP::load_class($class);
230 return $class->new( \%args );
234 my ( $self, $c, $name, @attrs ) = @_;
238 foreach my $attr (@attrs) {
240 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
242 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
245 if ( defined $value ) {
246 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
248 push( @{ $raw_attributes{$key} }, $value );
252 #I know that the original behavior was to ignore action if actions was set
253 # but i actually think this may be a little more sane? we can always remove
254 # the merge behavior quite easily and go back to having actions have
255 # presedence over action by modifying the keys. i honestly think this is
256 # superior while mantaining really high degree of compat
259 $actions = $self->actions;
261 my $cfg = $self->config;
262 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
265 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
267 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
270 my %final_attributes;
272 foreach my $key (keys %raw_attributes) {
274 my $raw = $raw_attributes{$key};
276 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
278 my $meth = "_parse_${key}_attr";
279 if ( my $code = $self->can($meth) ) {
280 ( $key, $value ) = $self->$code( $c, $name, $value );
282 push( @{ $final_attributes{$key} }, $value );
286 return \%final_attributes;
289 sub _parse_Global_attr {
290 my ( $self, $c, $name, $value ) = @_;
291 return $self->_parse_Path_attr( $c, $name, "/$name" );
294 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
296 sub _parse_Local_attr {
297 my ( $self, $c, $name, $value ) = @_;
298 return $self->_parse_Path_attr( $c, $name, $name );
301 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
303 sub _parse_Path_attr {
304 my ( $self, $c, $name, $value ) = @_;
305 $value = '' if !defined $value;
306 if ( $value =~ m!^/! ) {
307 return ( 'Path', $value );
309 elsif ( length $value ) {
310 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
313 return ( 'Path', $self->path_prefix($c) );
317 sub _parse_Regex_attr {
318 my ( $self, $c, $name, $value ) = @_;
319 return ( 'Regex', $value );
322 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
324 sub _parse_LocalRegex_attr {
325 my ( $self, $c, $name, $value ) = @_;
326 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
328 my $prefix = $self->path_prefix( $c );
329 $prefix .= '/' if length( $prefix );
331 return ( 'Regex', "^${prefix}${value}" );
334 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
336 sub _parse_Chained_attr {
337 my ($self, $c, $name, $value) = @_;
339 if (defined($value) && length($value)) {
341 $value = '/'.$self->action_namespace($c);
342 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
343 my @parts = split '/', $self->action_namespace($c);
344 my @levels = split '/', $rel;
346 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
347 } elsif ($value !~ m/^\//) {
348 my $action_ns = $self->action_namespace($c);
351 $value = '/'.join('/', $action_ns, $value);
353 $value = '/'.$value; # special case namespace '' (root)
360 return Chained => $value;
363 sub _parse_ChainedParent_attr {
364 my ($self, $c, $name, $value) = @_;
365 return $self->_parse_Chained_attr($c, $name, '../'.$name);
368 sub _parse_PathPrefix_attr {
370 return PathPart => $self->path_prefix;
373 sub _parse_ActionClass_attr {
374 my ( $self, $c, $name, $value ) = @_;
375 unless ( $value =~ s/^\+// ) {
376 $value = join('::', $self->_action_class, $value );
378 return ( 'ActionClass', $value );
381 sub _parse_MyAction_attr {
382 my ( $self, $c, $name, $value ) = @_;
384 my $appclass = Catalyst::Utils::class2appclass($self);
385 $value = "${appclass}::Action::${value}";
387 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.