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 my @methods = $meta->get_all_methods_with_attributes;
186 foreach my $method (@methods) {
187 my $name = $method->name;
188 my $attributes = $method->attributes;
189 next unless $attributes;
190 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
191 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
192 $c->log->debug( 'Bad action definition "'
193 . join( ' ', @{ $attributes } )
194 . qq/" for "$class->$name"/ )
198 my $reverse = $namespace ? "${namespace}/${name}" : $name;
199 my $action = $self->create_action(
201 code => $method->body,
203 namespace => $namespace,
205 attributes => $attrs,
208 $c->dispatcher->register( $c, $action );
216 my $class = (exists $args{attributes}{ActionClass}
217 ? $args{attributes}{ActionClass}[0]
218 : $self->_action_class);
220 Class::MOP::load_class($class);
221 return $class->new( \%args );
225 my ( $self, $c, $name, @attrs ) = @_;
229 foreach my $attr (@attrs) {
231 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
233 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
236 if ( defined $value ) {
237 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
239 push( @{ $raw_attributes{$key} }, $value );
243 #I know that the original behavior was to ignore action if actions was set
244 # but i actually think this may be a little more sane? we can always remove
245 # the merge behavior quite easily and go back to having actions have
246 # presedence over action by modifying the keys. i honestly think this is
247 # superior while mantaining really high degree of compat
250 $actions = $self->actions;
252 my $cfg = $self->config;
253 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
256 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
258 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
261 my %final_attributes;
263 foreach my $key (keys %raw_attributes) {
265 my $raw = $raw_attributes{$key};
267 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
269 my $meth = "_parse_${key}_attr";
270 if ( my $code = $self->can($meth) ) {
271 ( $key, $value ) = $self->$code( $c, $name, $value );
273 push( @{ $final_attributes{$key} }, $value );
277 return \%final_attributes;
280 sub _parse_Global_attr {
281 my ( $self, $c, $name, $value ) = @_;
282 return $self->_parse_Path_attr( $c, $name, "/$name" );
285 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
287 sub _parse_Local_attr {
288 my ( $self, $c, $name, $value ) = @_;
289 return $self->_parse_Path_attr( $c, $name, $name );
292 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
294 sub _parse_Path_attr {
295 my ( $self, $c, $name, $value ) = @_;
296 $value = '' if !defined $value;
297 if ( $value =~ m!^/! ) {
298 return ( 'Path', $value );
300 elsif ( length $value ) {
301 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
304 return ( 'Path', $self->path_prefix($c) );
308 sub _parse_Regex_attr {
309 my ( $self, $c, $name, $value ) = @_;
310 return ( 'Regex', $value );
313 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
315 sub _parse_LocalRegex_attr {
316 my ( $self, $c, $name, $value ) = @_;
317 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
319 my $prefix = $self->path_prefix( $c );
320 $prefix .= '/' if length( $prefix );
322 return ( 'Regex', "^${prefix}${value}" );
325 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
327 sub _parse_Chained_attr {
328 my ($self, $c, $name, $value) = @_;
330 if (defined($value) && length($value)) {
332 $value = '/'.$self->action_namespace($c);
333 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
334 my @parts = split '/', $self->action_namespace($c);
335 my @levels = split '/', $rel;
337 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
338 } elsif ($value !~ m/^\//) {
339 my $action_ns = $self->action_namespace($c);
342 $value = '/'.join('/', $action_ns, $value);
344 $value = '/'.$value; # special case namespace '' (root)
351 return Chained => $value;
354 sub _parse_ChainedParent_attr {
355 my ($self, $c, $name, $value) = @_;
356 return $self->_parse_Chained_attr($c, $name, '../'.$name);
359 sub _parse_PathPrefix_attr {
361 return PathPart => $self->path_prefix;
364 sub _parse_ActionClass_attr {
365 my ( $self, $c, $name, $value ) = @_;
366 unless ( $value =~ s/^\+// ) {
367 $value = join('::', $self->_action_class, $value );
369 return ( 'ActionClass', $value );
372 sub _parse_MyAction_attr {
373 my ( $self, $c, $name, $value ) = @_;
375 my $appclass = Catalyst::Utils::class2appclass($self);
376 $value = "${appclass}::Action::${value}";
378 return ( 'ActionClass', $value );
381 __PACKAGE__->meta->make_immutable;
389 Like any other L<Catalyst::Component>, controllers have a config hash,
390 accessible through $self->config from the controller actions. Some
391 settings are in use by the Catalyst framework:
395 This specifies the internal namespace the controller should be bound
396 to. By default the controller is bound to the URI version of the
397 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
398 will be bound to 'foo/bar'. The default Root controller is an example
399 of setting namespace to '' (the null string).
403 Sets 'path_prefix', as described below.
407 =head2 $class->new($app, @args)
409 Proxies through to NEXT::new and stashes the application instance as
412 =head2 $self->action_for('name')
414 Returns the Catalyst::Action object (if any) for a given method name
417 =head2 $self->register_actions($c)
419 Finds all applicable actions for this component, creates
420 Catalyst::Action objects (using $self->create_action) for them and
421 registers them with $c->dispatcher.
423 =head2 $self->action_namespace($c)
425 Returns the private namespace for actions in this component. Defaults
426 to a value from the controller name (for
427 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
428 overridden from the "namespace" config key.
431 =head2 $self->path_prefix($c)
433 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
434 relative :Path actions in this component. Defaults to the action_namespace or
435 can be overridden from the "path" config key.
437 =head2 $self->create_action(%args)
439 Called with a hash of data to be use for construction of a new
440 Catalyst::Action (or appropriate sub/alternative class) object.
442 Primarily designed for the use of register_actions.
444 =head2 $self->_application
448 Returns the application instance stored by C<new()>
452 Catalyst Contributors, see Catalyst.pm
456 This program is free software, you can redistribute it and/or modify
457 it under the same terms as Perl itself.