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("Metaclass for " . ref($meta) ." for " . $meta->name
185 . " cannot support register_actions.")
186 unless $meta->can('get_all_methods_with_attributes');
187 my @methods = $meta->get_all_methods_with_attributes;
189 foreach my $method (@methods) {
190 my $name = $method->name;
191 my $attributes = $method->attributes;
192 next unless $attributes;
193 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
194 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
195 $c->log->debug( 'Bad action definition "'
196 . join( ' ', @{ $attributes } )
197 . qq/" for "$class->$name"/ )
201 my $reverse = $namespace ? "${namespace}/${name}" : $name;
202 my $action = $self->create_action(
204 code => $method->body,
206 namespace => $namespace,
208 attributes => $attrs,
211 $c->dispatcher->register( $c, $action );
219 my $class = (exists $args{attributes}{ActionClass}
220 ? $args{attributes}{ActionClass}[0]
221 : $self->_action_class);
223 Class::MOP::load_class($class);
224 return $class->new( \%args );
228 my ( $self, $c, $name, @attrs ) = @_;
232 foreach my $attr (@attrs) {
234 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
236 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
239 if ( defined $value ) {
240 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
242 push( @{ $raw_attributes{$key} }, $value );
246 #I know that the original behavior was to ignore action if actions was set
247 # but i actually think this may be a little more sane? we can always remove
248 # the merge behavior quite easily and go back to having actions have
249 # presedence over action by modifying the keys. i honestly think this is
250 # superior while mantaining really high degree of compat
253 $actions = $self->actions;
255 my $cfg = $self->config;
256 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
259 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
261 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
264 my %final_attributes;
266 foreach my $key (keys %raw_attributes) {
268 my $raw = $raw_attributes{$key};
270 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
272 my $meth = "_parse_${key}_attr";
273 if ( my $code = $self->can($meth) ) {
274 ( $key, $value ) = $self->$code( $c, $name, $value );
276 push( @{ $final_attributes{$key} }, $value );
280 return \%final_attributes;
283 sub _parse_Global_attr {
284 my ( $self, $c, $name, $value ) = @_;
285 return $self->_parse_Path_attr( $c, $name, "/$name" );
288 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
290 sub _parse_Local_attr {
291 my ( $self, $c, $name, $value ) = @_;
292 return $self->_parse_Path_attr( $c, $name, $name );
295 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
297 sub _parse_Path_attr {
298 my ( $self, $c, $name, $value ) = @_;
299 $value = '' if !defined $value;
300 if ( $value =~ m!^/! ) {
301 return ( 'Path', $value );
303 elsif ( length $value ) {
304 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
307 return ( 'Path', $self->path_prefix($c) );
311 sub _parse_Regex_attr {
312 my ( $self, $c, $name, $value ) = @_;
313 return ( 'Regex', $value );
316 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
318 sub _parse_LocalRegex_attr {
319 my ( $self, $c, $name, $value ) = @_;
320 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
322 my $prefix = $self->path_prefix( $c );
323 $prefix .= '/' if length( $prefix );
325 return ( 'Regex', "^${prefix}${value}" );
328 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
330 sub _parse_Chained_attr {
331 my ($self, $c, $name, $value) = @_;
333 if (defined($value) && length($value)) {
335 $value = '/'.$self->action_namespace($c);
336 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
337 my @parts = split '/', $self->action_namespace($c);
338 my @levels = split '/', $rel;
340 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
341 } elsif ($value !~ m/^\//) {
342 my $action_ns = $self->action_namespace($c);
345 $value = '/'.join('/', $action_ns, $value);
347 $value = '/'.$value; # special case namespace '' (root)
354 return Chained => $value;
357 sub _parse_ChainedParent_attr {
358 my ($self, $c, $name, $value) = @_;
359 return $self->_parse_Chained_attr($c, $name, '../'.$name);
362 sub _parse_PathPrefix_attr {
364 return PathPart => $self->path_prefix;
367 sub _parse_ActionClass_attr {
368 my ( $self, $c, $name, $value ) = @_;
369 unless ( $value =~ s/^\+// ) {
370 $value = join('::', $self->_action_class, $value );
372 return ( 'ActionClass', $value );
375 sub _parse_MyAction_attr {
376 my ( $self, $c, $name, $value ) = @_;
378 my $appclass = Catalyst::Utils::class2appclass($self);
379 $value = "${appclass}::Action::${value}";
381 return ( 'ActionClass', $value );
384 __PACKAGE__->meta->make_immutable;
392 Like any other L<Catalyst::Component>, controllers have a config hash,
393 accessible through $self->config from the controller actions. Some
394 settings are in use by the Catalyst framework:
398 This specifies the internal namespace the controller should be bound
399 to. By default the controller is bound to the URI version of the
400 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
401 will be bound to 'foo/bar'. The default Root controller is an example
402 of setting namespace to '' (the null string).
406 Sets 'path_prefix', as described below.
410 =head2 $class->new($app, @args)
412 Proxies through to NEXT::new and stashes the application instance as
415 =head2 $self->action_for('name')
417 Returns the Catalyst::Action object (if any) for a given method name
420 =head2 $self->register_actions($c)
422 Finds all applicable actions for this component, creates
423 Catalyst::Action objects (using $self->create_action) for them and
424 registers them with $c->dispatcher.
426 =head2 $self->action_namespace($c)
428 Returns the private namespace for actions in this component. Defaults
429 to a value from the controller name (for
430 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
431 overridden from the "namespace" config key.
434 =head2 $self->path_prefix($c)
436 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
437 relative :Path actions in this component. Defaults to the action_namespace or
438 can be overridden from the "path" config key.
440 =head2 $self->create_action(%args)
442 Called with a hash of data to be use for construction of a new
443 Catalyst::Action (or appropriate sub/alternative class) object.
445 Primarily designed for the use of register_actions.
447 =head2 $self->_application
451 Returns the application instance stored by C<new()>
455 Catalyst Contributors, see Catalyst.pm
459 This program is free software, you can redistribute it and/or modify
460 it under the same terms as Perl itself.