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;
17 predicate => 'has_path_prefix',
20 has action_namespace =>
24 init_arg => 'namespace',
25 predicate => 'has_action_namespace',
35 # Future - isa => 'ClassName|Catalyst' performance?
36 # required => 1 breaks tests..
37 has _application => (is => 'ro');
38 sub _app { shift->_application(@_) }
40 override 'BUILDARGS' => sub {
41 my ($self, $app) = @_;
44 $args->{_application} = $app;
50 my ($self, $args) = @_;
51 my $action = delete $args->{action} || {};
52 my $actions = delete $args->{actions} || {};
53 my $attr_value = $self->merge_config_hashes($actions, $action);
54 $self->actions($attr_value);
59 Catalyst::Controller - Catalyst Controller base class
63 package MyApp::Controller::Search
64 use base qw/Catalyst::Controller/;
67 my ($self,$c,@args) = @_;
69 } # Dispatches to /search/foo
73 Controllers are where the actions in the Catalyst framework
74 reside. Each action is represented by a function with an attribute to
75 identify what kind of action it is. See the L<Catalyst::Dispatcher>
76 for more info about how Catalyst dispatches to actions.
80 #I think both of these could be attributes. doesn't really seem like they need
81 #to ble class data. i think that attributes +default would work just fine
82 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
84 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
85 __PACKAGE__->_action_class('Catalyst::Action');
88 sub _DISPATCH : Private {
89 my ( $self, $c ) = @_;
91 foreach my $disp ( @{ $self->_dispatch_steps } ) {
92 last unless $c->forward($disp);
98 sub _BEGIN : Private {
99 my ( $self, $c ) = @_;
100 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
101 return 1 unless $begin;
102 $begin->dispatch( $c );
103 return !@{ $c->error };
106 sub _AUTO : Private {
107 my ( $self, $c ) = @_;
108 my @auto = $c->get_actions( 'auto', $c->namespace );
109 foreach my $auto (@auto) {
110 $auto->dispatch( $c );
111 return 0 unless $c->state;
116 sub _ACTION : Private {
117 my ( $self, $c ) = @_;
119 && $c->action->can('execute')
120 && defined $c->req->action )
122 $c->action->dispatch( $c );
124 return !@{ $c->error };
128 my ( $self, $c ) = @_;
129 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
130 return 1 unless $end;
131 $end->dispatch( $c );
132 return !@{ $c->error };
136 my ( $self, $name ) = @_;
137 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
138 return $app->dispatcher->get_action($name, $self->action_namespace);
141 #my opinion is that this whole sub really should be a builder method, not
142 #something that happens on every call. Anyone else disagree?? -- groditi
143 ## -- apparently this is all just waiting for app/ctx split
144 around action_namespace => sub {
146 my ( $self, $c ) = @_;
149 return $self->$orig if $self->has_action_namespace;
151 return $self->config->{namespace} if exists $self->config->{namespace};
156 $case_s = $c->config->{case_sensitive};
158 if ($self->isa('Catalyst')) {
159 $case_s = $self->config->{case_sensitive};
162 $case_s = $self->_application->config->{case_sensitive};
164 confess("Can't figure out case_sensitive setting");
169 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
170 $self->$orig($namespace) if ref($self);
174 #Once again, this is probably better written as a builder method
175 around path_prefix => sub {
179 return $self->$orig if $self->has_path_prefix;
181 return $self->config->{path} if exists $self->config->{path};
183 my $namespace = $self->action_namespace(@_);
184 $self->$orig($namespace) if ref($self);
189 sub register_actions {
190 my ( $self, $c ) = @_;
191 my $class = ref $self || $self;
192 #this is still not correct for some reason.
193 my $namespace = $self->action_namespace($c);
194 my $meta = $self->Class::MOP::Object::meta();
195 my %methods = map { $_->body => $_->name }
196 grep { $_->package_name ne 'Moose::Object' } #ignore Moose::Object methods
197 $meta->get_all_methods;
199 # Advanced inheritance support for plugins and the like
200 #moose todo: migrate to eliminate CDI compat
202 for my $isa ( $meta->superclasses, $class ) {
203 if(my $coderef = $isa->can('_action_cache')){
204 push(@action_cache, @{ $isa->$coderef });
208 foreach my $cache (@action_cache) {
209 my $code = $cache->[0];
210 my $method = delete $methods{$code}; # avoid dupe registers
212 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
213 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
214 $c->log->debug( 'Bad action definition "'
215 . join( ' ', @{ $cache->[1] } )
216 . qq/" for "$class->$method"/ )
220 my $reverse = $namespace ? "${namespace}/${method}" : $method;
221 my $action = $self->create_action(
225 namespace => $namespace,
227 attributes => $attrs,
230 $c->dispatcher->register( $c, $action );
238 my $class = (exists $args{attributes}{ActionClass}
239 ? $args{attributes}{ActionClass}[0]
240 : $self->_action_class);
242 Class::MOP::load_class($class);
243 return $class->new( \%args );
247 my ( $self, $c, $name, @attrs ) = @_;
251 foreach my $attr (@attrs) {
253 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
255 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
258 if ( defined $value ) {
259 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
261 push( @{ $raw_attributes{$key} }, $value );
265 #I know that the original behavior was to ignore action if actions was set
266 # but i actually think this may be a little more sane? we can always remove
267 # the merge behavior quite easily and go back to having actions have
268 # presedence over action by modifying the keys. i honestly think this is
269 # superior while mantaining really high degree of compat
272 $actions = $self->actions;
274 my $cfg = $self->config;
275 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
278 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
280 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
283 my %final_attributes;
285 foreach my $key (keys %raw_attributes) {
287 my $raw = $raw_attributes{$key};
289 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
291 my $meth = "_parse_${key}_attr";
292 if ( my $code = $self->can($meth) ) {
293 ( $key, $value ) = $self->$code( $c, $name, $value );
295 push( @{ $final_attributes{$key} }, $value );
299 return \%final_attributes;
302 sub _parse_Global_attr {
303 my ( $self, $c, $name, $value ) = @_;
304 return $self->_parse_Path_attr( $c, $name, "/$name" );
307 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
309 sub _parse_Local_attr {
310 my ( $self, $c, $name, $value ) = @_;
311 return $self->_parse_Path_attr( $c, $name, $name );
314 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
316 sub _parse_Path_attr {
317 my ( $self, $c, $name, $value ) = @_;
318 $value = '' if !defined $value;
319 if ( $value =~ m!^/! ) {
320 return ( 'Path', $value );
322 elsif ( length $value ) {
323 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
326 return ( 'Path', $self->path_prefix($c) );
330 sub _parse_Regex_attr {
331 my ( $self, $c, $name, $value ) = @_;
332 return ( 'Regex', $value );
335 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
337 sub _parse_LocalRegex_attr {
338 my ( $self, $c, $name, $value ) = @_;
339 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
341 my $prefix = $self->path_prefix( $c );
342 $prefix .= '/' if length( $prefix );
344 return ( 'Regex', "^${prefix}${value}" );
347 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
349 sub _parse_Chained_attr {
350 my ($self, $c, $name, $value) = @_;
352 if (defined($value) && length($value)) {
354 $value = '/'.$self->action_namespace($c);
355 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
356 my @parts = split '/', $self->action_namespace($c);
357 my @levels = split '/', $rel;
359 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
360 } elsif ($value !~ m/^\//) {
361 my $action_ns = $self->action_namespace($c);
364 $value = '/'.join('/', $action_ns, $value);
366 $value = '/'.$value; # special case namespace '' (root)
373 return Chained => $value;
376 sub _parse_ChainedParent_attr {
377 my ($self, $c, $name, $value) = @_;
378 return $self->_parse_Chained_attr($c, $name, '../'.$name);
381 sub _parse_PathPrefix_attr {
383 return PathPart => $self->path_prefix;
386 sub _parse_ActionClass_attr {
387 my ( $self, $c, $name, $value ) = @_;
388 unless ( $value =~ s/^\+// ) {
389 $value = join('::', $self->_action_class, $value );
391 return ( 'ActionClass', $value );
394 sub _parse_MyAction_attr {
395 my ( $self, $c, $name, $value ) = @_;
397 my $appclass = Catalyst::Utils::class2appclass($self);
398 $value = "${appclass}::Action::${value}";
400 return ( 'ActionClass', $value );
405 __PACKAGE__->meta->make_immutable;
413 Like any other L<Catalyst::Component>, controllers have a config hash,
414 accessible through $self->config from the controller actions. Some
415 settings are in use by the Catalyst framework:
419 This specifies the internal namespace the controller should be bound
420 to. By default the controller is bound to the URI version of the
421 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
422 will be bound to 'foo/bar'. The default Root controller is an example
423 of setting namespace to '' (the null string).
427 Sets 'path_prefix', as described below.
431 =head2 $class->new($app, @args)
433 Proxies through to NEXT::new and stashes the application instance as
436 =head2 $self->action_for('name')
438 Returns the Catalyst::Action object (if any) for a given method name
441 =head2 $self->register_actions($c)
443 Finds all applicable actions for this component, creates
444 Catalyst::Action objects (using $self->create_action) for them and
445 registers them with $c->dispatcher.
447 =head2 $self->action_namespace($c)
449 Returns the private namespace for actions in this component. Defaults
450 to a value from the controller name (for
451 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
452 overridden from the "namespace" config key.
455 =head2 $self->path_prefix($c)
457 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
458 relative :Path actions in this component. Defaults to the action_namespace or
459 can be overridden from the "path" config key.
461 =head2 $self->create_action(%args)
463 Called with a hash of data to be use for construction of a new
464 Catalyst::Action (or appropriate sub/alternative class) object.
466 Primarily designed for the use of register_actions.
468 =head2 $self->_application
472 Returns the application instance stored by C<new()>
476 Catalyst Contributors, see Catalyst.pm
480 This program is free software, you can redistribute it and/or modify
481 it under the same terms as Perl itself.