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 MooseX::MethodAttributes;
11 use Catalyst::Exception;
14 with 'Catalyst::Component::ApplicationAttribute';
21 predicate => 'has_path_prefix',
24 has action_namespace =>
28 init_arg => 'namespace',
29 predicate => 'has_action_namespace',
32 has _controller_actions =>
40 my ($self, $args) = @_;
41 my $action = delete $args->{action} || {};
42 my $actions = delete $args->{actions} || {};
43 my $attr_value = $self->merge_config_hashes($actions, $action);
44 $self->_controller_actions($attr_value);
49 Catalyst::Controller - Catalyst Controller base class
53 package MyApp::Controller::Search
54 use base qw/Catalyst::Controller/;
57 my ($self,$c,@args) = @_;
59 } # Dispatches to /search/foo
63 Controllers are where the actions in the Catalyst framework
64 reside. Each action is represented by a function with an attribute to
65 identify what kind of action it is. See the L<Catalyst::Dispatcher>
66 for more info about how Catalyst dispatches to actions.
70 #I think both of these could be attributes. doesn't really seem like they need
71 #to ble class data. i think that attributes +default would work just fine
72 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
74 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
75 __PACKAGE__->_action_class('Catalyst::Action');
78 sub _DISPATCH : Private {
79 my ( $self, $c ) = @_;
81 foreach my $disp ( @{ $self->_dispatch_steps } ) {
82 last unless $c->forward($disp);
88 sub _BEGIN : Private {
89 my ( $self, $c ) = @_;
90 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
91 return 1 unless $begin;
92 $begin->dispatch( $c );
93 return !@{ $c->error };
97 my ( $self, $c ) = @_;
98 my @auto = $c->get_actions( 'auto', $c->namespace );
99 foreach my $auto (@auto) {
100 $auto->dispatch( $c );
101 return 0 unless $c->state;
106 sub _ACTION : Private {
107 my ( $self, $c ) = @_;
109 && $c->action->can('execute')
110 && defined $c->req->action )
112 $c->action->dispatch( $c );
114 return !@{ $c->error };
118 my ( $self, $c ) = @_;
119 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
120 return 1 unless $end;
121 $end->dispatch( $c );
122 return !@{ $c->error };
126 my ( $self, $name ) = @_;
127 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
128 return $app->dispatcher->get_action($name, $self->action_namespace);
131 #my opinion is that this whole sub really should be a builder method, not
132 #something that happens on every call. Anyone else disagree?? -- groditi
133 ## -- apparently this is all just waiting for app/ctx split
134 around action_namespace => sub {
136 my ( $self, $c ) = @_;
139 return $self->$orig if $self->has_action_namespace;
141 return $self->config->{namespace} if exists $self->config->{namespace};
146 $case_s = $c->config->{case_sensitive};
148 if ($self->isa('Catalyst')) {
149 $case_s = $self->config->{case_sensitive};
152 $case_s = $self->_application->config->{case_sensitive};
154 confess("Can't figure out case_sensitive setting");
159 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
160 $self->$orig($namespace) if ref($self);
164 #Once again, this is probably better written as a builder method
165 around path_prefix => sub {
169 return $self->$orig if $self->has_path_prefix;
171 return $self->config->{path} if exists $self->config->{path};
173 my $namespace = $self->action_namespace(@_);
174 $self->$orig($namespace) if ref($self);
178 sub get_action_methods {
180 my $meta = find_meta($self);
181 confess("Metaclass for " . ref($meta) ." for " . $meta->name
182 . " cannot support register_actions.")
183 unless $meta->can('get_nearest_methods_with_attributes');
184 my @methods = $meta->get_nearest_methods_with_attributes;
188 sub register_actions {
189 my ( $self, $c ) = @_;
190 $self->register_action_methods( $c, $self->get_action_methods );
193 sub register_action_methods {
194 my ( $self, $c, @methods ) = @_;
195 my $class = ref $self || $self;
196 #this is still not correct for some reason.
197 my $namespace = $self->action_namespace($c);
199 foreach my $method (@methods) {
200 my $name = $method->name;
201 my $attributes = $method->attributes;
202 next unless $attributes;
203 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
204 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
205 $c->log->debug( 'Bad action definition "'
206 . join( ' ', @{ $attributes } )
207 . qq/" for "$class->$name"/ )
211 my $reverse = $namespace ? "${namespace}/${name}" : $name;
212 my $action = $self->create_action(
214 code => $method->body,
216 namespace => $namespace,
218 attributes => $attrs,
221 $c->dispatcher->register( $c, $action );
229 my $class = (exists $args{attributes}{ActionClass}
230 ? $args{attributes}{ActionClass}[0]
231 : $self->_action_class);
233 Class::MOP::load_class($class);
234 return $class->new( \%args );
238 my ( $self, $c, $name, @attrs ) = @_;
242 foreach my $attr (@attrs) {
244 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
246 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
249 if ( defined $value ) {
250 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
252 push( @{ $raw_attributes{$key} }, $value );
256 #I know that the original behavior was to ignore action if actions was set
257 # but i actually think this may be a little more sane? we can always remove
258 # the merge behavior quite easily and go back to having actions have
259 # presedence over action by modifying the keys. i honestly think this is
260 # superior while mantaining really high degree of compat
263 $actions = $self->_controller_actions;
265 my $cfg = $self->config;
266 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
269 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
271 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
274 my %final_attributes;
276 foreach my $key (keys %raw_attributes) {
278 my $raw = $raw_attributes{$key};
280 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
282 my $meth = "_parse_${key}_attr";
283 if ( my $code = $self->can($meth) ) {
284 ( $key, $value ) = $self->$code( $c, $name, $value );
286 push( @{ $final_attributes{$key} }, $value );
290 return \%final_attributes;
293 sub _parse_Global_attr {
294 my ( $self, $c, $name, $value ) = @_;
295 return $self->_parse_Path_attr( $c, $name, "/$name" );
298 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
300 sub _parse_Local_attr {
301 my ( $self, $c, $name, $value ) = @_;
302 return $self->_parse_Path_attr( $c, $name, $name );
305 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
307 sub _parse_Path_attr {
308 my ( $self, $c, $name, $value ) = @_;
309 $value = '' if !defined $value;
310 if ( $value =~ m!^/! ) {
311 return ( 'Path', $value );
313 elsif ( length $value ) {
314 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
317 return ( 'Path', $self->path_prefix($c) );
321 sub _parse_Regex_attr {
322 my ( $self, $c, $name, $value ) = @_;
323 return ( 'Regex', $value );
326 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
328 sub _parse_LocalRegex_attr {
329 my ( $self, $c, $name, $value ) = @_;
330 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
332 my $prefix = $self->path_prefix( $c );
333 $prefix .= '/' if length( $prefix );
335 return ( 'Regex', "^${prefix}${value}" );
338 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
340 sub _parse_Chained_attr {
341 my ($self, $c, $name, $value) = @_;
343 if (defined($value) && length($value)) {
345 $value = '/'.$self->action_namespace($c);
346 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
347 my @parts = split '/', $self->action_namespace($c);
348 my @levels = split '/', $rel;
350 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
351 } elsif ($value !~ m/^\//) {
352 my $action_ns = $self->action_namespace($c);
355 $value = '/'.join('/', $action_ns, $value);
357 $value = '/'.$value; # special case namespace '' (root)
364 return Chained => $value;
367 sub _parse_ChainedParent_attr {
368 my ($self, $c, $name, $value) = @_;
369 return $self->_parse_Chained_attr($c, $name, '../'.$name);
372 sub _parse_PathPrefix_attr {
374 return PathPart => $self->path_prefix;
377 sub _parse_ActionClass_attr {
378 my ( $self, $c, $name, $value ) = @_;
379 unless ( $value =~ s/^\+// ) {
380 $value = join('::', $self->_action_class, $value );
382 return ( 'ActionClass', $value );
385 sub _parse_MyAction_attr {
386 my ( $self, $c, $name, $value ) = @_;
388 my $appclass = Catalyst::Utils::class2appclass($self);
389 $value = "${appclass}::Action::${value}";
391 return ( 'ActionClass', $value );
394 __PACKAGE__->meta->make_immutable;
402 Like any other L<Catalyst::Component>, controllers have a config hash,
403 accessible through $self->config from the controller actions. Some
404 settings are in use by the Catalyst framework:
408 This specifies the internal namespace the controller should be bound
409 to. By default the controller is bound to the URI version of the
410 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
411 will be bound to 'foo/bar'. The default Root controller is an example
412 of setting namespace to '' (the null string).
416 Sets 'path_prefix', as described below.
420 =head2 BUILDARGS ($app, @args)
422 From L<Catalyst::Component::ApplicationAttribute>, stashes the application
423 instance as $self->_application.
425 =head2 $self->action_for('name')
427 Returns the Catalyst::Action object (if any) for a given method name
430 =head2 $self->action_namespace($c)
432 Returns the private namespace for actions in this component. Defaults
433 to a value from the controller name (for
434 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
435 overridden from the "namespace" config key.
438 =head2 $self->path_prefix($c)
440 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
441 relative :Path actions in this component. Defaults to the action_namespace or
442 can be overridden from the "path" config key.
444 =head2 $self->register_actions($c)
446 Finds all applicable actions for this component, creates
447 Catalyst::Action objects (using $self->create_action) for them and
448 registers them with $c->dispatcher.
450 =head2 $self->get_action_methods()
452 Returns a list of L<Moose::Meta::Method> objects, doing the
453 L<MooseX::MethodAttributes::Role::Meta::Method> role, which are the set of
454 action methods for this package.
456 =head2 $self->register_action_methods($c, @methods)
458 Creates action objects for a set of action methods using C< create_action >,
459 and registers them with the dispatcher.
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 =head2 $self->_application
470 Returns the application instance stored by C<new()>
474 Catalyst Contributors, see Catalyst.pm
478 This library is free software. You can redistribute it and/or modify
479 it under the same terms as Perl itself.