1 package Catalyst::Controller;
3 #switch to BEGIN { extends qw/ ... /; } ?
4 use base qw/Catalyst::Component Catalyst::AttrContainer/;
7 use Scalar::Util qw/blessed/;
8 use Catalyst::Exception;
17 predicate => 'has_path_prefix',
20 has action_namespace =>
24 init_arg => 'namespace',
25 predicate => 'has_action_namespace',
35 # isa => 'ClassName|Catalyst' ?
36 has _application => (is => 'rw');
37 sub _app{ shift->_application(@_) } # eww
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->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')
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 };
129 my $new = $self->$orig(@_);
130 $new->_application( $app );
135 my ( $self, $name ) = @_;
136 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
137 return $app->dispatcher->get_action($name, $self->action_namespace);
140 around action_namespace => sub {
141 my ( $orig, $self, $c ) = @_;
144 return $self->$orig if $self->has_action_namespace;
146 return $self->config->{namespace} if exists $self->config->{namespace};
149 #the following looks like a possible target for a default setting. i am not
150 #making the below the builder because i don't know if $c will vary from
151 #call to call, which would affect case sensitivitysettings -- groditi
154 $case_s = $c->config->{case_sensitive};
156 if ($self->isa('Catalyst')) {
157 $case_s = $self->config->{case_sensitive};
160 $case_s = $self->_application->config->{case_sensitive};
162 confess("Can't figure out case_sensitive setting");
167 return Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
171 around path_prefix => sub {
175 return $self->$orig if $self->has_path_prefix;
177 return $self->config->{path} if exists $self->config->{path};
179 return $self->action_namespace(@_);
183 sub register_actions {
184 my ( $self, $c ) = @_;
185 my $class = ref $self || $self;
186 #this is still not correct for some reason.
187 my $namespace = $self->action_namespace($c);
189 if( $self->can('meta') ){
190 my $meta = $self->meta;
191 %methods = map{ $_->{code}->body => $_->{name} }
192 grep {$_->{class} ne 'Moose::Object'} #ignore Moose::Object methods
193 $meta->compute_all_applicable_methods;
194 } else { #until we are sure there's no moose stuff left...
195 $methods{ $self->can($_) } = $_
196 for @{ Class::Inspector->methods($class) || [] };
199 # Advanced inheritance support for plugins and the like
200 #to be modified to use meta->superclasses
201 #moose todo: migrate to eliminate CDI compat
205 for my $isa ( @{"$class\::ISA"}, $class ) {
206 push @action_cache, @{ $isa->_action_cache }
207 if $isa->can('_action_cache');
211 foreach my $cache (@action_cache) {
212 my $code = $cache->[0];
213 my $method = delete $methods{$code}; # avoid dupe registers
215 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
216 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
217 $c->log->debug( 'Bad action definition "'
218 . join( ' ', @{ $cache->[1] } )
219 . qq/" for "$class->$method"/ )
223 my $reverse = $namespace ? "${namespace}/${method}" : $method;
224 my $action = $self->create_action(
228 namespace => $namespace,
230 attributes => $attrs,
233 $c->dispatcher->register( $c, $action );
241 my $class = (exists $args{attributes}{ActionClass}
242 ? $args{attributes}{ActionClass}[0]
243 : $self->_action_class);
245 Class::MOP::load_class($class);
246 return $class->new( \%args );
250 my ( $self, $c, $name, @attrs ) = @_;
254 foreach my $attr (@attrs) {
256 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
258 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
261 if ( defined $value ) {
262 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
264 push( @{ $raw_attributes{$key} }, $value );
268 #I know that the original behavior was to ignore action if actions was set
269 # but i actually think this may be a little more sane? we can always remove
270 # the merge behavior quite easily and go back to having actions have
271 # presedence over action by modifying the keys. i honestly think this is
272 # superior while mantaining really high degree of compat
275 $actions = $self->actions;
277 my $cfg = $self->config;
278 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
281 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
283 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
286 my %final_attributes;
288 foreach my $key (keys %raw_attributes) {
290 my $raw = $raw_attributes{$key};
292 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
294 my $meth = "_parse_${key}_attr";
295 if ( my $code = $self->can($meth) ) {
296 ( $key, $value ) = $self->$code( $c, $name, $value );
298 push( @{ $final_attributes{$key} }, $value );
302 return \%final_attributes;
305 sub _parse_Global_attr {
306 my ( $self, $c, $name, $value ) = @_;
307 return $self->_parse_Path_attr( $c, $name, "/$name" );
310 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
312 sub _parse_Local_attr {
313 my ( $self, $c, $name, $value ) = @_;
314 return $self->_parse_Path_attr( $c, $name, $name );
317 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
319 sub _parse_Path_attr {
320 my ( $self, $c, $name, $value ) = @_;
322 if ( $value =~ m!^/! ) {
323 return ( 'Path', $value );
325 elsif ( length $value ) {
326 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
329 return ( 'Path', $self->path_prefix($c) );
333 sub _parse_Regex_attr {
334 my ( $self, $c, $name, $value ) = @_;
335 return ( 'Regex', $value );
338 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
340 sub _parse_LocalRegex_attr {
341 my ( $self, $c, $name, $value ) = @_;
342 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
343 return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" );
346 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
348 sub _parse_ActionClass_attr {
349 my ( $self, $c, $name, $value ) = @_;
350 unless ( $value =~ s/^\+// ) {
351 $value = join('::', $self->_action_class, $value );
353 return ( 'ActionClass', $value );
356 sub _parse_MyAction_attr {
357 my ( $self, $c, $name, $value ) = @_;
359 my $appclass = Catalyst::Utils::class2appclass($self);
360 $value = "${appclass}::Action::${value}";
362 return ( 'ActionClass', $value );
371 Like any other L<Catalyst::Component>, controllers have a config hash,
372 accessible through $self->config from the controller actions. Some
373 settings are in use by the Catalyst framework:
377 This specifies the internal namespace the controller should be bound
378 to. By default the controller is bound to the URI version of the
379 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
380 will be bound to 'foo/bar'. The default Root controller is an example
381 of setting namespace to '' (the null string).
385 Sets 'path_prefix', as described below.
389 =head2 $class->new($app, @args)
391 Proxies through to NEXT::new and stashes the application instance as
394 =head2 $self->action_for('name')
396 Returns the Catalyst::Action object (if any) for a given method name
399 =head2 $self->register_actions($c)
401 Finds all applicable actions for this component, creates
402 Catalyst::Action objects (using $self->create_action) for them and
403 registers them with $c->dispatcher.
405 =head2 $self->action_namespace($c)
407 Returns the private namespace for actions in this component. Defaults
408 to a value from the controller name (for
409 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
410 overridden from the "namespace" config key.
413 =head2 $self->path_prefix($c)
415 Returns the default path prefix for :Local, :LocalRegex and relative
416 :Path actions in this component. Defaults to the action_namespace or
417 can be overridden from the "path" config key.
419 =head2 $self->create_action(%args)
421 Called with a hash of data to be use for construction of a new
422 Catalyst::Action (or appropriate sub/alternative class) object.
424 Primarily designed for the use of register_actions.
426 =head2 $self->_application
430 Returns the application instance stored by C<new()>
434 Sebastian Riedel, C<sri@oook.de>
435 Marcus Ramberg C<mramberg@cpan.org>
439 This program is free software, you can redistribute it and/or modify
440 it under the same terms as Perl itself.