1 package Catalyst::Controller;
3 #switch to BEGIN { extends qw/ ... /; } ?
5 use base qw/Catalyst::Component Catalyst::AttrContainer/;
8 use Scalar::Util qw/blessed/;
9 use Catalyst::Exception;
18 predicate => 'has_path_prefix',
21 has action_namespace =>
25 init_arg => 'namespace',
26 predicate => 'has_action_namespace',
36 # isa => 'ClassName|Catalyst' ?
37 has _application => (is => 'rw');
38 sub _app{ shift->_application(@_) }
41 my ($self, $args) = @_;
42 my $action = delete $args->{action} || {};
43 my $actions = delete $args->{actions} || {};
44 my $attr_value = $self->merge_config_hashes($actions, $action);
45 $self->actions($attr_value);
50 Catalyst::Controller - Catalyst Controller base class
54 package MyApp::Controller::Search
55 use base qw/Catalyst::Controller/;
58 my ($self,$c,@args) = @_;
60 } # Dispatches to /search/foo
64 Controllers are where the actions in the Catalyst framework
65 reside. Each action is represented by a function with an attribute to
66 identify what kind of action it is. See the L<Catalyst::Dispatcher>
67 for more info about how Catalyst dispatches to actions.
71 #I think both of these could be attributes. doesn't really seem like they need
72 #to ble class data. i think that attributes +default would work just fine
73 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
75 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
76 __PACKAGE__->_action_class('Catalyst::Action');
79 sub _DISPATCH : Private {
80 my ( $self, $c ) = @_;
82 foreach my $disp ( @{ $self->_dispatch_steps } ) {
83 last unless $c->forward($disp);
89 sub _BEGIN : Private {
90 my ( $self, $c ) = @_;
91 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
92 return 1 unless $begin;
93 $begin->dispatch( $c );
94 return !@{ $c->error };
98 my ( $self, $c ) = @_;
99 my @auto = $c->get_actions( 'auto', $c->namespace );
100 foreach my $auto (@auto) {
101 $auto->dispatch( $c );
102 return 0 unless $c->state;
107 sub _ACTION : Private {
108 my ( $self, $c ) = @_;
110 && $c->action->can('execute')
113 $c->action->dispatch( $c );
115 return !@{ $c->error };
119 my ( $self, $c ) = @_;
120 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
121 return 1 unless $end;
122 $end->dispatch( $c );
123 return !@{ $c->error };
129 my $new = $self->next::method(@_);
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
143 #we are wrapping the accessor, so just uyse a modifier since a normal sub would
144 #just be overridden by the generated moose method
145 around action_namespace => sub {
147 my ( $self, $c ) = @_;
150 return $self->$orig if $self->has_action_namespace;
152 warn "action_namespace called as class method";
153 # if the following won't change at runtime it should be lazy_building thing
154 return $self->config->{namespace} if exists $self->config->{namespace};
157 #the following looks like a possible target for a default setting. i am not
158 #making the below the builder because i don't know if $c will vary from
159 #call to call, which would affect case sensitivity settings -- groditi
162 $case_s = $c->config->{case_sensitive};
164 if ($self->isa('Catalyst')) {
165 $case_s = $self->config->{case_sensitive};
168 $case_s = $self->_application->config->{case_sensitive};
170 confess("Can't figure out case_sensitive setting");
175 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
176 $self->$orig($namespace) if ref($self);
180 #Once again, this is probably better written as a builder method
181 around path_prefix => sub {
185 return $self->$orig if $self->has_path_prefix;
187 return $self->config->{path} if exists $self->config->{path};
189 my $namespace = $self->action_namespace(@_);
190 $self->$orig($namespace) if ref($self);
195 sub register_actions {
196 my ( $self, $c ) = @_;
197 my $class = ref $self || $self;
198 #this is still not correct for some reason.
199 my $namespace = $self->action_namespace($c);
200 my $meta = $self->meta;
201 my %methods = map{ $_->{code}->body => $_->{name} }
202 grep {$_->{class} ne 'Moose::Object'} #ignore Moose::Object methods
203 $meta->compute_all_applicable_methods;
206 # Advanced inheritance support for plugins and the like
207 #moose todo: migrate to eliminate CDI compat
209 for my $isa ( $meta->superclasses, $class ) {
210 if(my $coderef = $isa->can('_action_cache')){
211 push(@action_cache, @{ $isa->$coderef });
215 foreach my $cache (@action_cache) {
216 my $code = $cache->[0];
217 my $method = delete $methods{$code}; # avoid dupe registers
219 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
220 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
221 $c->log->debug( 'Bad action definition "'
222 . join( ' ', @{ $cache->[1] } )
223 . qq/" for "$class->$method"/ )
227 my $reverse = $namespace ? "${namespace}/${method}" : $method;
228 my $action = $self->create_action(
232 namespace => $namespace,
234 attributes => $attrs,
237 $c->dispatcher->register( $c, $action );
245 my $class = (exists $args{attributes}{ActionClass}
246 ? $args{attributes}{ActionClass}[0]
247 : $self->_action_class);
249 Class::MOP::load_class($class);
250 return $class->new( \%args );
254 my ( $self, $c, $name, @attrs ) = @_;
258 foreach my $attr (@attrs) {
260 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
262 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
265 if ( defined $value ) {
266 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
268 push( @{ $raw_attributes{$key} }, $value );
272 #I know that the original behavior was to ignore action if actions was set
273 # but i actually think this may be a little more sane? we can always remove
274 # the merge behavior quite easily and go back to having actions have
275 # presedence over action by modifying the keys. i honestly think this is
276 # superior while mantaining really high degree of compat
279 $actions = $self->actions;
281 my $cfg = $self->config;
282 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
285 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
287 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
290 my %final_attributes;
292 foreach my $key (keys %raw_attributes) {
294 my $raw = $raw_attributes{$key};
296 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
298 my $meth = "_parse_${key}_attr";
299 if ( my $code = $self->can($meth) ) {
300 ( $key, $value ) = $self->$code( $c, $name, $value );
302 push( @{ $final_attributes{$key} }, $value );
306 return \%final_attributes;
309 sub _parse_Global_attr {
310 my ( $self, $c, $name, $value ) = @_;
311 return $self->_parse_Path_attr( $c, $name, "/$name" );
314 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
316 sub _parse_Local_attr {
317 my ( $self, $c, $name, $value ) = @_;
318 return $self->_parse_Path_attr( $c, $name, $name );
321 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
323 sub _parse_Path_attr {
324 my ( $self, $c, $name, $value ) = @_;
326 if ( $value =~ m!^/! ) {
327 return ( 'Path', $value );
329 elsif ( length $value ) {
330 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
333 return ( 'Path', $self->path_prefix($c) );
337 sub _parse_Regex_attr {
338 my ( $self, $c, $name, $value ) = @_;
339 return ( 'Regex', $value );
342 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
344 sub _parse_LocalRegex_attr {
345 my ( $self, $c, $name, $value ) = @_;
346 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
347 return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" );
350 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
352 sub _parse_ActionClass_attr {
353 my ( $self, $c, $name, $value ) = @_;
354 unless ( $value =~ s/^\+// ) {
355 $value = join('::', $self->_action_class, $value );
357 return ( 'ActionClass', $value );
360 sub _parse_MyAction_attr {
361 my ( $self, $c, $name, $value ) = @_;
363 my $appclass = Catalyst::Utils::class2appclass($self);
364 $value = "${appclass}::Action::${value}";
366 return ( 'ActionClass', $value );
377 Like any other L<Catalyst::Component>, controllers have a config hash,
378 accessible through $self->config from the controller actions. Some
379 settings are in use by the Catalyst framework:
383 This specifies the internal namespace the controller should be bound
384 to. By default the controller is bound to the URI version of the
385 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
386 will be bound to 'foo/bar'. The default Root controller is an example
387 of setting namespace to '' (the null string).
391 Sets 'path_prefix', as described below.
395 =head2 $class->new($app, @args)
397 Proxies through to NEXT::new and stashes the application instance as
400 =head2 $self->action_for('name')
402 Returns the Catalyst::Action object (if any) for a given method name
405 =head2 $self->register_actions($c)
407 Finds all applicable actions for this component, creates
408 Catalyst::Action objects (using $self->create_action) for them and
409 registers them with $c->dispatcher.
411 =head2 $self->action_namespace($c)
413 Returns the private namespace for actions in this component. Defaults
414 to a value from the controller name (for
415 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
416 overridden from the "namespace" config key.
419 =head2 $self->path_prefix($c)
421 Returns the default path prefix for :Local, :LocalRegex and relative
422 :Path actions in this component. Defaults to the action_namespace or
423 can be overridden from the "path" config key.
425 =head2 $self->create_action(%args)
427 Called with a hash of data to be use for construction of a new
428 Catalyst::Action (or appropriate sub/alternative class) object.
430 Primarily designed for the use of register_actions.
432 =head2 $self->_application
436 Returns the application instance stored by C<new()>
440 Sebastian Riedel, C<sri@oook.de>
441 Marcus Ramberg C<mramberg@cpan.org>
445 This program is free software, you can redistribute it and/or modify
446 it under the same terms as Perl itself.