1 package Catalyst::Controller;
4 use Moose::Util qw/find_meta/;
6 use namespace::clean -except => 'meta';
8 BEGIN { extends qw/Catalyst::Component MooseX::MethodAttributes::Inheritable/; }
10 use Catalyst::Exception;
13 with 'Catalyst::Component::ApplicationAttribute';
20 predicate => 'has_path_prefix',
23 has action_namespace =>
27 init_arg => 'namespace',
28 predicate => 'has_action_namespace',
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 };
125 my ( $self, $name ) = @_;
126 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
127 return $app->dispatcher->get_action($name, $self->action_namespace);
130 #my opinion is that this whole sub really should be a builder method, not
131 #something that happens on every call. Anyone else disagree?? -- groditi
132 ## -- apparently this is all just waiting for app/ctx split
133 around action_namespace => sub {
135 my ( $self, $c ) = @_;
138 return $self->$orig if $self->has_action_namespace;
140 return $self->config->{namespace} if exists $self->config->{namespace};
145 $case_s = $c->config->{case_sensitive};
147 if ($self->isa('Catalyst')) {
148 $case_s = $self->config->{case_sensitive};
151 $case_s = $self->_application->config->{case_sensitive};
153 confess("Can't figure out case_sensitive setting");
158 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
159 $self->$orig($namespace) if ref($self);
163 #Once again, this is probably better written as a builder method
164 around path_prefix => sub {
168 return $self->$orig if $self->has_path_prefix;
170 return $self->config->{path} if exists $self->config->{path};
172 my $namespace = $self->action_namespace(@_);
173 $self->$orig($namespace) if ref($self);
178 sub register_actions {
179 my ( $self, $c ) = @_;
180 my $class = ref $self || $self;
181 #this is still not correct for some reason.
182 my $namespace = $self->action_namespace($c);
183 my $meta = find_meta($self);
184 confess("Wrong metaclass $meta for $self - " . $meta->name)
185 unless $meta->can('get_all_methods_with_attributes');
186 my @methods = $meta->get_all_methods_with_attributes;
188 foreach my $method (@methods) {
189 my $name = $method->name;
190 my $attributes = $method->attributes;
191 next unless $attributes;
192 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
193 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
194 $c->log->debug( 'Bad action definition "'
195 . join( ' ', @{ $attributes } )
196 . qq/" for "$class->$name"/ )
200 my $reverse = $namespace ? "${namespace}/${name}" : $name;
201 my $action = $self->create_action(
203 code => $method->body,
205 namespace => $namespace,
207 attributes => $attrs,
210 $c->dispatcher->register( $c, $action );
218 my $class = (exists $args{attributes}{ActionClass}
219 ? $args{attributes}{ActionClass}[0]
220 : $self->_action_class);
222 Class::MOP::load_class($class);
223 return $class->new( \%args );
227 my ( $self, $c, $name, @attrs ) = @_;
231 foreach my $attr (@attrs) {
233 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
235 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
238 if ( defined $value ) {
239 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
241 push( @{ $raw_attributes{$key} }, $value );
245 #I know that the original behavior was to ignore action if actions was set
246 # but i actually think this may be a little more sane? we can always remove
247 # the merge behavior quite easily and go back to having actions have
248 # presedence over action by modifying the keys. i honestly think this is
249 # superior while mantaining really high degree of compat
252 $actions = $self->actions;
254 my $cfg = $self->config;
255 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
258 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
260 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
263 my %final_attributes;
265 foreach my $key (keys %raw_attributes) {
267 my $raw = $raw_attributes{$key};
269 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
271 my $meth = "_parse_${key}_attr";
272 if ( my $code = $self->can($meth) ) {
273 ( $key, $value ) = $self->$code( $c, $name, $value );
275 push( @{ $final_attributes{$key} }, $value );
279 return \%final_attributes;
282 sub _parse_Global_attr {
283 my ( $self, $c, $name, $value ) = @_;
284 return $self->_parse_Path_attr( $c, $name, "/$name" );
287 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
289 sub _parse_Local_attr {
290 my ( $self, $c, $name, $value ) = @_;
291 return $self->_parse_Path_attr( $c, $name, $name );
294 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
296 sub _parse_Path_attr {
297 my ( $self, $c, $name, $value ) = @_;
298 $value = '' if !defined $value;
299 if ( $value =~ m!^/! ) {
300 return ( 'Path', $value );
302 elsif ( length $value ) {
303 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
306 return ( 'Path', $self->path_prefix($c) );
310 sub _parse_Regex_attr {
311 my ( $self, $c, $name, $value ) = @_;
312 return ( 'Regex', $value );
315 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
317 sub _parse_LocalRegex_attr {
318 my ( $self, $c, $name, $value ) = @_;
319 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
321 my $prefix = $self->path_prefix( $c );
322 $prefix .= '/' if length( $prefix );
324 return ( 'Regex', "^${prefix}${value}" );
327 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
329 sub _parse_Chained_attr {
330 my ($self, $c, $name, $value) = @_;
332 if (defined($value) && length($value)) {
334 $value = '/'.$self->action_namespace($c);
335 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
336 my @parts = split '/', $self->action_namespace($c);
337 my @levels = split '/', $rel;
339 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
340 } elsif ($value !~ m/^\//) {
341 my $action_ns = $self->action_namespace($c);
344 $value = '/'.join('/', $action_ns, $value);
346 $value = '/'.$value; # special case namespace '' (root)
353 return Chained => $value;
356 sub _parse_ChainedParent_attr {
357 my ($self, $c, $name, $value) = @_;
358 return $self->_parse_Chained_attr($c, $name, '../'.$name);
361 sub _parse_PathPrefix_attr {
363 return PathPart => $self->path_prefix;
366 sub _parse_ActionClass_attr {
367 my ( $self, $c, $name, $value ) = @_;
368 unless ( $value =~ s/^\+// ) {
369 $value = join('::', $self->_action_class, $value );
371 return ( 'ActionClass', $value );
374 sub _parse_MyAction_attr {
375 my ( $self, $c, $name, $value ) = @_;
377 my $appclass = Catalyst::Utils::class2appclass($self);
378 $value = "${appclass}::Action::${value}";
380 return ( 'ActionClass', $value );
383 __PACKAGE__->meta->make_immutable;
391 Like any other L<Catalyst::Component>, controllers have a config hash,
392 accessible through $self->config from the controller actions. Some
393 settings are in use by the Catalyst framework:
397 This specifies the internal namespace the controller should be bound
398 to. By default the controller is bound to the URI version of the
399 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
400 will be bound to 'foo/bar'. The default Root controller is an example
401 of setting namespace to '' (the null string).
405 Sets 'path_prefix', as described below.
409 =head2 $class->new($app, @args)
411 Proxies through to NEXT::new and stashes the application instance as
414 =head2 $self->action_for('name')
416 Returns the Catalyst::Action object (if any) for a given method name
419 =head2 $self->register_actions($c)
421 Finds all applicable actions for this component, creates
422 Catalyst::Action objects (using $self->create_action) for them and
423 registers them with $c->dispatcher.
425 =head2 $self->action_namespace($c)
427 Returns the private namespace for actions in this component. Defaults
428 to a value from the controller name (for
429 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
430 overridden from the "namespace" config key.
433 =head2 $self->path_prefix($c)
435 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
436 relative :Path actions in this component. Defaults to the action_namespace or
437 can be overridden from the "path" config key.
439 =head2 $self->create_action(%args)
441 Called with a hash of data to be use for construction of a new
442 Catalyst::Action (or appropriate sub/alternative class) object.
444 Primarily designed for the use of register_actions.
446 =head2 $self->_application
450 Returns the application instance stored by C<new()>
454 Catalyst Contributors, see Catalyst.pm
458 This program is free software, you can redistribute it and/or modify
459 it under the same terms as Perl itself.