1 package Catalyst::Controller;
3 #switch to BEGIN { extends qw/ ... /; } ?
4 use base qw/Catalyst::Component Catalyst::AttrContainer/;
7 use Scalar::Util qw/blessed/;
8 use Catalyst::Exception;
17 predicate => 'has_path_prefix',
20 has action_namespace =>
24 init_arg => 'namespace',
25 predicate => 'has_action_namespace',
35 # isa => 'ClassName|Catalyst' ?
36 has _application => (is => 'rw');
37 sub _app{ shift->_application(@_) }
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 };
129 my $new = $self->$orig(@_);
130 $new->_application( $app );
135 my ( $self, $name ) = @_;
136 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
137 return $app->dispatcher->get_action($name, $self->action_namespace);
140 #my opinion is that this whole sub really should be a builder method, not
141 #something that happens on every call. Anyone else disagree?? -- groditi
142 ## -- apparently this is all just waiting for app/ctx split
143 around action_namespace => sub {
145 my ( $self, $c ) = @_;
148 return $self->$orig if $self->has_action_namespace;
150 return $self->config->{namespace} if exists $self->config->{namespace};
155 $case_s = $c->config->{case_sensitive};
157 if ($self->isa('Catalyst')) {
158 $case_s = $self->config->{case_sensitive};
161 $case_s = $self->_application->config->{case_sensitive};
163 confess("Can't figure out case_sensitive setting");
168 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
169 $self->$orig($namespace) if ref($self);
173 #Once again, this is probably better written as a builder method
174 around path_prefix => sub {
178 return $self->$orig if $self->has_path_prefix;
180 return $self->config->{path} if exists $self->config->{path};
182 my $namespace = $self->action_namespace(@_);
183 $self->$orig($namespace) if ref($self);
188 sub register_actions {
189 my ( $self, $c ) = @_;
190 my $class = ref $self || $self;
191 #this is still not correct for some reason.
192 my $namespace = $self->action_namespace($c);
193 my $meta = $self->meta;
194 my %methods = map { $_->body => $_->name }
195 grep { $_->package_name ne 'Moose::Object' } #ignore Moose::Object methods
196 $meta->get_all_methods;
198 # Advanced inheritance support for plugins and the like
199 #moose todo: migrate to eliminate CDI compat
201 for my $isa ( $meta->superclasses, $class ) {
202 if(my $coderef = $isa->can('_action_cache')){
203 push(@action_cache, @{ $isa->$coderef });
207 foreach my $cache (@action_cache) {
208 my $code = $cache->[0];
209 my $method = delete $methods{$code}; # avoid dupe registers
211 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
212 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
213 $c->log->debug( 'Bad action definition "'
214 . join( ' ', @{ $cache->[1] } )
215 . qq/" for "$class->$method"/ )
219 my $reverse = $namespace ? "${namespace}/${method}" : $method;
220 my $action = $self->create_action(
224 namespace => $namespace,
226 attributes => $attrs,
229 $c->dispatcher->register( $c, $action );
237 my $class = (exists $args{attributes}{ActionClass}
238 ? $args{attributes}{ActionClass}[0]
239 : $self->_action_class);
241 Class::MOP::load_class($class);
242 return $class->new( \%args );
246 my ( $self, $c, $name, @attrs ) = @_;
250 foreach my $attr (@attrs) {
252 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
254 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
257 if ( defined $value ) {
258 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
260 push( @{ $raw_attributes{$key} }, $value );
264 #I know that the original behavior was to ignore action if actions was set
265 # but i actually think this may be a little more sane? we can always remove
266 # the merge behavior quite easily and go back to having actions have
267 # presedence over action by modifying the keys. i honestly think this is
268 # superior while mantaining really high degree of compat
271 $actions = $self->actions;
273 my $cfg = $self->config;
274 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
277 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
279 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
282 my %final_attributes;
284 foreach my $key (keys %raw_attributes) {
286 my $raw = $raw_attributes{$key};
288 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
290 my $meth = "_parse_${key}_attr";
291 if ( my $code = $self->can($meth) ) {
292 ( $key, $value ) = $self->$code( $c, $name, $value );
294 push( @{ $final_attributes{$key} }, $value );
298 return \%final_attributes;
301 sub _parse_Global_attr {
302 my ( $self, $c, $name, $value ) = @_;
303 return $self->_parse_Path_attr( $c, $name, "/$name" );
306 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
308 sub _parse_Local_attr {
309 my ( $self, $c, $name, $value ) = @_;
310 return $self->_parse_Path_attr( $c, $name, $name );
313 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
315 sub _parse_Path_attr {
316 my ( $self, $c, $name, $value ) = @_;
317 $value = '' if !defined $value;
318 if ( $value =~ m!^/! ) {
319 return ( 'Path', $value );
321 elsif ( length $value ) {
322 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
325 return ( 'Path', $self->path_prefix($c) );
329 sub _parse_Regex_attr {
330 my ( $self, $c, $name, $value ) = @_;
331 return ( 'Regex', $value );
334 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
336 sub _parse_LocalRegex_attr {
337 my ( $self, $c, $name, $value ) = @_;
338 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
340 my $prefix = $self->path_prefix( $c );
341 $prefix .= '/' if length( $prefix );
343 return ( 'Regex', "^${prefix}${value}" );
346 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
348 sub _parse_Chained_attr {
349 my ($self, $c, $name, $value) = @_;
351 if (defined($value) && length($value)) {
353 $value = '/'.$self->action_namespace($c);
354 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
355 my @parts = split '/', $self->action_namespace($c);
356 my @levels = split '/', $rel;
358 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
359 } elsif ($value !~ m/^\//) {
360 my $action_ns = $self->action_namespace($c);
363 $value = '/'.join('/', $action_ns, $value);
365 $value = '/'.$value; # special case namespace '' (root)
372 return Chained => $value;
375 sub _parse_ChainedParent_attr {
376 my ($self, $c, $name, $value) = @_;
377 return $self->_parse_Chained_attr($c, $name, '../'.$name);
380 sub _parse_PathPrefix_attr {
382 return PathPart => $self->path_prefix;
385 sub _parse_ActionClass_attr {
386 my ( $self, $c, $name, $value ) = @_;
387 unless ( $value =~ s/^\+// ) {
388 $value = join('::', $self->_action_class, $value );
390 return ( 'ActionClass', $value );
393 sub _parse_MyAction_attr {
394 my ( $self, $c, $name, $value ) = @_;
396 my $appclass = Catalyst::Utils::class2appclass($self);
397 $value = "${appclass}::Action::${value}";
399 return ( 'ActionClass', $value );
404 __PACKAGE__->meta->make_immutable;
412 Like any other L<Catalyst::Component>, controllers have a config hash,
413 accessible through $self->config from the controller actions. Some
414 settings are in use by the Catalyst framework:
418 This specifies the internal namespace the controller should be bound
419 to. By default the controller is bound to the URI version of the
420 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
421 will be bound to 'foo/bar'. The default Root controller is an example
422 of setting namespace to '' (the null string).
426 Sets 'path_prefix', as described below.
430 =head2 $class->new($app, @args)
432 Proxies through to NEXT::new and stashes the application instance as
435 =head2 $self->action_for('name')
437 Returns the Catalyst::Action object (if any) for a given method name
440 =head2 $self->register_actions($c)
442 Finds all applicable actions for this component, creates
443 Catalyst::Action objects (using $self->create_action) for them and
444 registers them with $c->dispatcher.
446 =head2 $self->action_namespace($c)
448 Returns the private namespace for actions in this component. Defaults
449 to a value from the controller name (for
450 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
451 overridden from the "namespace" config key.
454 =head2 $self->path_prefix($c)
456 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
457 relative :Path actions in this component. Defaults to the action_namespace or
458 can be overridden from the "path" config key.
460 =head2 $self->create_action(%args)
462 Called with a hash of data to be use for construction of a new
463 Catalyst::Action (or appropriate sub/alternative class) object.
465 Primarily designed for the use of register_actions.
467 =head2 $self->_application
471 Returns the application instance stored by C<new()>
475 Catalyst Contributors, see Catalyst.pm
479 This program is free software, you can redistribute it and/or modify
480 it under the same terms as Perl itself.