1 package Catalyst::Controller;
4 use Moose::Util qw/find_meta does_role/;
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 = grep { does_role($_, 'MooseX::MethodAttributes::Role::Meta::Method') }
185 $meta->get_all_methods;
187 foreach my $method (@methods) {
188 my $name = $method->name;
189 my $attributes = $method->attributes;
190 next unless $attributes;
191 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
192 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
193 $c->log->debug( 'Bad action definition "'
194 . join( ' ', @{ $attributes } )
195 . qq/" for "$class->$name"/ )
199 my $reverse = $namespace ? "${namespace}/${name}" : $name;
200 my $action = $self->create_action(
202 code => $method->body,
204 namespace => $namespace,
206 attributes => $attrs,
209 $c->dispatcher->register( $c, $action );
217 my $class = (exists $args{attributes}{ActionClass}
218 ? $args{attributes}{ActionClass}[0]
219 : $self->_action_class);
221 Class::MOP::load_class($class);
222 return $class->new( \%args );
226 my ( $self, $c, $name, @attrs ) = @_;
230 foreach my $attr (@attrs) {
232 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
234 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
237 if ( defined $value ) {
238 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
240 push( @{ $raw_attributes{$key} }, $value );
244 #I know that the original behavior was to ignore action if actions was set
245 # but i actually think this may be a little more sane? we can always remove
246 # the merge behavior quite easily and go back to having actions have
247 # presedence over action by modifying the keys. i honestly think this is
248 # superior while mantaining really high degree of compat
251 $actions = $self->actions;
253 my $cfg = $self->config;
254 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
257 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
259 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
262 my %final_attributes;
264 foreach my $key (keys %raw_attributes) {
266 my $raw = $raw_attributes{$key};
268 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
270 my $meth = "_parse_${key}_attr";
271 if ( my $code = $self->can($meth) ) {
272 ( $key, $value ) = $self->$code( $c, $name, $value );
274 push( @{ $final_attributes{$key} }, $value );
278 return \%final_attributes;
281 sub _parse_Global_attr {
282 my ( $self, $c, $name, $value ) = @_;
283 return $self->_parse_Path_attr( $c, $name, "/$name" );
286 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
288 sub _parse_Local_attr {
289 my ( $self, $c, $name, $value ) = @_;
290 return $self->_parse_Path_attr( $c, $name, $name );
293 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
295 sub _parse_Path_attr {
296 my ( $self, $c, $name, $value ) = @_;
297 $value = '' if !defined $value;
298 if ( $value =~ m!^/! ) {
299 return ( 'Path', $value );
301 elsif ( length $value ) {
302 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
305 return ( 'Path', $self->path_prefix($c) );
309 sub _parse_Regex_attr {
310 my ( $self, $c, $name, $value ) = @_;
311 return ( 'Regex', $value );
314 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
316 sub _parse_LocalRegex_attr {
317 my ( $self, $c, $name, $value ) = @_;
318 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
320 my $prefix = $self->path_prefix( $c );
321 $prefix .= '/' if length( $prefix );
323 return ( 'Regex', "^${prefix}${value}" );
326 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
328 sub _parse_Chained_attr {
329 my ($self, $c, $name, $value) = @_;
331 if (defined($value) && length($value)) {
333 $value = '/'.$self->action_namespace($c);
334 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
335 my @parts = split '/', $self->action_namespace($c);
336 my @levels = split '/', $rel;
338 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
339 } elsif ($value !~ m/^\//) {
340 my $action_ns = $self->action_namespace($c);
343 $value = '/'.join('/', $action_ns, $value);
345 $value = '/'.$value; # special case namespace '' (root)
352 return Chained => $value;
355 sub _parse_ChainedParent_attr {
356 my ($self, $c, $name, $value) = @_;
357 return $self->_parse_Chained_attr($c, $name, '../'.$name);
360 sub _parse_PathPrefix_attr {
362 return PathPart => $self->path_prefix;
365 sub _parse_ActionClass_attr {
366 my ( $self, $c, $name, $value ) = @_;
367 unless ( $value =~ s/^\+// ) {
368 $value = join('::', $self->_action_class, $value );
370 return ( 'ActionClass', $value );
373 sub _parse_MyAction_attr {
374 my ( $self, $c, $name, $value ) = @_;
376 my $appclass = Catalyst::Utils::class2appclass($self);
377 $value = "${appclass}::Action::${value}";
379 return ( 'ActionClass', $value );
382 __PACKAGE__->meta->make_immutable;
390 Like any other L<Catalyst::Component>, controllers have a config hash,
391 accessible through $self->config from the controller actions. Some
392 settings are in use by the Catalyst framework:
396 This specifies the internal namespace the controller should be bound
397 to. By default the controller is bound to the URI version of the
398 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
399 will be bound to 'foo/bar'. The default Root controller is an example
400 of setting namespace to '' (the null string).
404 Sets 'path_prefix', as described below.
408 =head2 $class->new($app, @args)
410 Proxies through to NEXT::new and stashes the application instance as
413 =head2 $self->action_for('name')
415 Returns the Catalyst::Action object (if any) for a given method name
418 =head2 $self->register_actions($c)
420 Finds all applicable actions for this component, creates
421 Catalyst::Action objects (using $self->create_action) for them and
422 registers them with $c->dispatcher.
424 =head2 $self->action_namespace($c)
426 Returns the private namespace for actions in this component. Defaults
427 to a value from the controller name (for
428 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
429 overridden from the "namespace" config key.
432 =head2 $self->path_prefix($c)
434 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
435 relative :Path actions in this component. Defaults to the action_namespace or
436 can be overridden from the "path" config key.
438 =head2 $self->create_action(%args)
440 Called with a hash of data to be use for construction of a new
441 Catalyst::Action (or appropriate sub/alternative class) object.
443 Primarily designed for the use of register_actions.
445 =head2 $self->_application
449 Returns the application instance stored by C<new()>
453 Catalyst Contributors, see Catalyst.pm
457 This program is free software, you can redistribute it and/or modify
458 it under the same terms as Perl itself.