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;
16 predicate => 'has_path_prefix',
19 has action_namespace =>
23 init_arg => 'namespace',
24 predicate => 'has_action_namespace',
34 # isa => 'ClassName|Catalyst' ?
35 has _application => (is => 'rw');
36 sub _app{ shift->_application(@_) }
39 my ($self, $args) = @_;
40 my $action = delete $args->{action} || {};
41 my $actions = delete $args->{actions} || {};
42 my $attr_value = $self->merge_config_hashes($actions, $action);
43 $self->actions($attr_value);
48 Catalyst::Controller - Catalyst Controller base class
52 package MyApp::Controller::Search
53 use base qw/Catalyst::Controller/;
56 my ($self,$c,@args) = @_;
58 } # Dispatches to /search/foo
62 Controllers are where the actions in the Catalyst framework
63 reside. Each action is represented by a function with an attribute to
64 identify what kind of action it is. See the L<Catalyst::Dispatcher>
65 for more info about how Catalyst dispatches to actions.
69 #I think both of these could be attributes. doesn't really seem like they need
70 #to ble class data. i think that attributes +default would work just fine
71 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
73 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
74 __PACKAGE__->_action_class('Catalyst::Action');
77 sub _DISPATCH : Private {
78 my ( $self, $c ) = @_;
80 foreach my $disp ( @{ $self->_dispatch_steps } ) {
81 last unless $c->forward($disp);
87 sub _BEGIN : Private {
88 my ( $self, $c ) = @_;
89 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
90 return 1 unless $begin;
91 $begin->dispatch( $c );
92 return !@{ $c->error };
96 my ( $self, $c ) = @_;
97 my @auto = $c->get_actions( 'auto', $c->namespace );
98 foreach my $auto (@auto) {
99 $auto->dispatch( $c );
100 return 0 unless $c->state;
105 sub _ACTION : Private {
106 my ( $self, $c ) = @_;
108 && $c->action->can('execute')
109 && defined $c->req->action )
111 $c->action->dispatch( $c );
113 return !@{ $c->error };
117 my ( $self, $c ) = @_;
118 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
119 return 1 unless $end;
120 $end->dispatch( $c );
121 return !@{ $c->error };
128 my $new = $self->$orig(@_);
129 $new->_application( $app );
134 my ( $self, $name ) = @_;
135 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
136 return $app->dispatcher->get_action($name, $self->action_namespace);
139 #my opinion is that this whole sub really should be a builder method, not
140 #something that happens on every call. Anyone else disagree?? -- groditi
141 ## -- apparently this is all just waiting for app/ctx split
142 around action_namespace => sub {
144 my ( $self, $c ) = @_;
147 return $self->$orig if $self->has_action_namespace;
149 return $self->config->{namespace} if exists $self->config->{namespace};
154 $case_s = $c->config->{case_sensitive};
156 if ($self->isa('Catalyst')) {
157 $case_s = $self->config->{case_sensitive};
160 $case_s = $self->_application->config->{case_sensitive};
162 confess("Can't figure out case_sensitive setting");
167 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
168 $self->$orig($namespace) if ref($self);
172 #Once again, this is probably better written as a builder method
173 around path_prefix => sub {
177 return $self->$orig if $self->has_path_prefix;
179 return $self->config->{path} if exists $self->config->{path};
181 my $namespace = $self->action_namespace(@_);
182 $self->$orig($namespace) if ref($self);
187 sub register_actions {
188 my ( $self, $c ) = @_;
189 my $class = ref $self || $self;
190 #this is still not correct for some reason.
191 my $namespace = $self->action_namespace($c);
192 my $meta = $self->meta;
193 my %methods = map { $_->body => $_->name }
194 grep { $_->package_name ne 'Moose::Object' } #ignore Moose::Object methods
195 $meta->get_all_methods;
197 # Advanced inheritance support for plugins and the like
198 #moose todo: migrate to eliminate CDI compat
200 for my $isa ( $meta->superclasses, $class ) {
201 if(my $coderef = $isa->can('_action_cache')){
202 push(@action_cache, @{ $isa->$coderef });
206 foreach my $cache (@action_cache) {
207 my $code = $cache->[0];
208 my $method = delete $methods{$code}; # avoid dupe registers
210 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
211 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
212 $c->log->debug( 'Bad action definition "'
213 . join( ' ', @{ $cache->[1] } )
214 . qq/" for "$class->$method"/ )
218 my $reverse = $namespace ? "${namespace}/${method}" : $method;
219 my $action = $self->create_action(
223 namespace => $namespace,
225 attributes => $attrs,
228 $c->dispatcher->register( $c, $action );
236 my $class = (exists $args{attributes}{ActionClass}
237 ? $args{attributes}{ActionClass}[0]
238 : $self->_action_class);
240 Class::MOP::load_class($class);
241 return $class->new( \%args );
245 my ( $self, $c, $name, @attrs ) = @_;
249 foreach my $attr (@attrs) {
251 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
253 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
256 if ( defined $value ) {
257 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
259 push( @{ $raw_attributes{$key} }, $value );
263 #I know that the original behavior was to ignore action if actions was set
264 # but i actually think this may be a little more sane? we can always remove
265 # the merge behavior quite easily and go back to having actions have
266 # presedence over action by modifying the keys. i honestly think this is
267 # superior while mantaining really high degree of compat
270 $actions = $self->actions;
272 my $cfg = $self->config;
273 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
276 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
278 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
281 my %final_attributes;
283 foreach my $key (keys %raw_attributes) {
285 my $raw = $raw_attributes{$key};
287 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
289 my $meth = "_parse_${key}_attr";
290 if ( my $code = $self->can($meth) ) {
291 ( $key, $value ) = $self->$code( $c, $name, $value );
293 push( @{ $final_attributes{$key} }, $value );
297 return \%final_attributes;
300 sub _parse_Global_attr {
301 my ( $self, $c, $name, $value ) = @_;
302 return $self->_parse_Path_attr( $c, $name, "/$name" );
305 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
307 sub _parse_Local_attr {
308 my ( $self, $c, $name, $value ) = @_;
309 return $self->_parse_Path_attr( $c, $name, $name );
312 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
314 sub _parse_Path_attr {
315 my ( $self, $c, $name, $value ) = @_;
316 $value = '' if !defined $value;
317 if ( $value =~ m!^/! ) {
318 return ( 'Path', $value );
320 elsif ( length $value ) {
321 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
324 return ( 'Path', $self->path_prefix($c) );
328 sub _parse_Regex_attr {
329 my ( $self, $c, $name, $value ) = @_;
330 return ( 'Regex', $value );
333 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
335 sub _parse_LocalRegex_attr {
336 my ( $self, $c, $name, $value ) = @_;
337 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
339 my $prefix = $self->path_prefix( $c );
340 $prefix .= '/' if length( $prefix );
342 return ( 'Regex', "^${prefix}${value}" );
345 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
347 sub _parse_Chained_attr {
348 my ($self, $c, $name, $value) = @_;
350 if (defined($value) && length($value)) {
352 $value = '/'.$self->action_namespace($c);
353 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
354 my @parts = split '/', $self->action_namespace($c);
355 my @levels = split '/', $rel;
357 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
358 } elsif ($value !~ m/^\//) {
359 my $action_ns = $self->action_namespace($c);
362 $value = '/'.join('/', $action_ns, $value);
364 $value = '/'.$value; # special case namespace '' (root)
371 return Chained => $value;
374 sub _parse_ChainedParent_attr {
375 my ($self, $c, $name, $value) = @_;
376 return $self->_parse_Chained_attr($c, $name, '../'.$name);
379 sub _parse_PathPrefix_attr {
381 return PathPart => $self->path_prefix;
384 sub _parse_ActionClass_attr {
385 my ( $self, $c, $name, $value ) = @_;
386 unless ( $value =~ s/^\+// ) {
387 $value = join('::', $self->_action_class, $value );
389 return ( 'ActionClass', $value );
392 sub _parse_MyAction_attr {
393 my ( $self, $c, $name, $value ) = @_;
395 my $appclass = Catalyst::Utils::class2appclass($self);
396 $value = "${appclass}::Action::${value}";
398 return ( 'ActionClass', $value );
403 __PACKAGE__->meta->make_immutable;
411 Like any other L<Catalyst::Component>, controllers have a config hash,
412 accessible through $self->config from the controller actions. Some
413 settings are in use by the Catalyst framework:
417 This specifies the internal namespace the controller should be bound
418 to. By default the controller is bound to the URI version of the
419 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
420 will be bound to 'foo/bar'. The default Root controller is an example
421 of setting namespace to '' (the null string).
425 Sets 'path_prefix', as described below.
429 =head2 $class->new($app, @args)
431 Proxies through to NEXT::new and stashes the application instance as
434 =head2 $self->action_for('name')
436 Returns the Catalyst::Action object (if any) for a given method name
439 =head2 $self->register_actions($c)
441 Finds all applicable actions for this component, creates
442 Catalyst::Action objects (using $self->create_action) for them and
443 registers them with $c->dispatcher.
445 =head2 $self->action_namespace($c)
447 Returns the private namespace for actions in this component. Defaults
448 to a value from the controller name (for
449 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
450 overridden from the "namespace" config key.
453 =head2 $self->path_prefix($c)
455 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
456 relative :Path actions in this component. Defaults to the action_namespace or
457 can be overridden from the "path" config key.
459 =head2 $self->create_action(%args)
461 Called with a hash of data to be use for construction of a new
462 Catalyst::Action (or appropriate sub/alternative class) object.
464 Primarily designed for the use of register_actions.
466 =head2 $self->_application
470 Returns the application instance stored by C<new()>
474 Catalyst Contributors, see Catalyst.pm
478 This program is free software, you can redistribute it and/or modify
479 it under the same terms as Perl itself.