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);
177 sub get_action_methods {
179 my $meta = find_meta($self);
180 confess("Metaclass for " . ref($meta) ." for " . $meta->name
181 . " cannot support register_actions.")
182 unless $meta->can('get_all_methods_with_attributes');
183 my @methods = $meta->get_all_methods_with_attributes;
187 sub register_actions {
188 my ( $self, $c ) = @_;
189 $self->register_action_methods( $c, $self->get_action_methods );
192 sub register_action_methods {
193 my ( $self, $c, @methods ) = @_;
194 my $class = ref $self || $self;
195 #this is still not correct for some reason.
196 my $namespace = $self->action_namespace($c);
198 foreach my $method (@methods) {
199 my $name = $method->name;
200 my $attributes = $method->attributes;
201 next unless $attributes;
202 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
203 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
204 $c->log->debug( 'Bad action definition "'
205 . join( ' ', @{ $attributes } )
206 . qq/" for "$class->$name"/ )
210 my $reverse = $namespace ? "${namespace}/${name}" : $name;
211 my $action = $self->create_action(
213 code => $method->body,
215 namespace => $namespace,
217 attributes => $attrs,
220 $c->dispatcher->register( $c, $action );
228 my $class = (exists $args{attributes}{ActionClass}
229 ? $args{attributes}{ActionClass}[0]
230 : $self->_action_class);
232 Class::MOP::load_class($class);
233 return $class->new( \%args );
237 my ( $self, $c, $name, @attrs ) = @_;
241 foreach my $attr (@attrs) {
243 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
245 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
248 if ( defined $value ) {
249 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
251 push( @{ $raw_attributes{$key} }, $value );
255 #I know that the original behavior was to ignore action if actions was set
256 # but i actually think this may be a little more sane? we can always remove
257 # the merge behavior quite easily and go back to having actions have
258 # presedence over action by modifying the keys. i honestly think this is
259 # superior while mantaining really high degree of compat
262 $actions = $self->actions;
264 my $cfg = $self->config;
265 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
268 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
270 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
273 my %final_attributes;
275 foreach my $key (keys %raw_attributes) {
277 my $raw = $raw_attributes{$key};
279 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
281 my $meth = "_parse_${key}_attr";
282 if ( my $code = $self->can($meth) ) {
283 ( $key, $value ) = $self->$code( $c, $name, $value );
285 push( @{ $final_attributes{$key} }, $value );
289 return \%final_attributes;
292 sub _parse_Global_attr {
293 my ( $self, $c, $name, $value ) = @_;
294 return $self->_parse_Path_attr( $c, $name, "/$name" );
297 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
299 sub _parse_Local_attr {
300 my ( $self, $c, $name, $value ) = @_;
301 return $self->_parse_Path_attr( $c, $name, $name );
304 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
306 sub _parse_Path_attr {
307 my ( $self, $c, $name, $value ) = @_;
308 $value = '' if !defined $value;
309 if ( $value =~ m!^/! ) {
310 return ( 'Path', $value );
312 elsif ( length $value ) {
313 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
316 return ( 'Path', $self->path_prefix($c) );
320 sub _parse_Regex_attr {
321 my ( $self, $c, $name, $value ) = @_;
322 return ( 'Regex', $value );
325 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
327 sub _parse_LocalRegex_attr {
328 my ( $self, $c, $name, $value ) = @_;
329 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
331 my $prefix = $self->path_prefix( $c );
332 $prefix .= '/' if length( $prefix );
334 return ( 'Regex', "^${prefix}${value}" );
337 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
339 sub _parse_Chained_attr {
340 my ($self, $c, $name, $value) = @_;
342 if (defined($value) && length($value)) {
344 $value = '/'.$self->action_namespace($c);
345 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
346 my @parts = split '/', $self->action_namespace($c);
347 my @levels = split '/', $rel;
349 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
350 } elsif ($value !~ m/^\//) {
351 my $action_ns = $self->action_namespace($c);
354 $value = '/'.join('/', $action_ns, $value);
356 $value = '/'.$value; # special case namespace '' (root)
363 return Chained => $value;
366 sub _parse_ChainedParent_attr {
367 my ($self, $c, $name, $value) = @_;
368 return $self->_parse_Chained_attr($c, $name, '../'.$name);
371 sub _parse_PathPrefix_attr {
373 return PathPart => $self->path_prefix;
376 sub _parse_ActionClass_attr {
377 my ( $self, $c, $name, $value ) = @_;
378 unless ( $value =~ s/^\+// ) {
379 $value = join('::', $self->_action_class, $value );
381 return ( 'ActionClass', $value );
384 sub _parse_MyAction_attr {
385 my ( $self, $c, $name, $value ) = @_;
387 my $appclass = Catalyst::Utils::class2appclass($self);
388 $value = "${appclass}::Action::${value}";
390 return ( 'ActionClass', $value );
393 __PACKAGE__->meta->make_immutable;
401 Like any other L<Catalyst::Component>, controllers have a config hash,
402 accessible through $self->config from the controller actions. Some
403 settings are in use by the Catalyst framework:
407 This specifies the internal namespace the controller should be bound
408 to. By default the controller is bound to the URI version of the
409 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
410 will be bound to 'foo/bar'. The default Root controller is an example
411 of setting namespace to '' (the null string).
415 Sets 'path_prefix', as described below.
419 =head2 BUILDARGS ($app, @args)
421 From L<Catalyst::Component::ApplicationAttribute>, stashes the application
422 instance as $self->_application.
424 =head2 $self->action_for('name')
426 Returns the Catalyst::Action object (if any) for a given method name
429 =head2 $self->action_namespace($c)
431 Returns the private namespace for actions in this component. Defaults
432 to a value from the controller name (for
433 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
434 overridden from the "namespace" config key.
437 =head2 $self->path_prefix($c)
439 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
440 relative :Path actions in this component. Defaults to the action_namespace or
441 can be overridden from the "path" config key.
443 =head2 $self->register_actions($c)
445 Finds all applicable actions for this component, creates
446 Catalyst::Action objects (using $self->create_action) for them and
447 registers them with $c->dispatcher.
449 =head2 $self->get_action_methods()
451 Returns a list of L<Moose::Meta::Method> objects, doing the
452 L<MooseX::MethodAttributes::Role::Meta::Method> role, which are the set of
453 action methods for this package.
455 =head2 $self->register_action_methods($c, @methods)
457 Creates action objects for a set of action methods using C< create_action >,
458 and registers them with the dispatcher.
460 =head2 $self->create_action(%args)
462 Called with a hash of data to be use for construction of a new
463 Catalyst::Action (or appropriate sub/alternative class) object.
465 =head2 $self->_application
469 Returns the application instance stored by C<new()>
473 Catalyst Contributors, see Catalyst.pm
477 This program is free software, you can redistribute it and/or modify
478 it under the same terms as Perl itself.