1 package Catalyst::Controller;
3 #switch to BEGIN { extends qw/ ... /; } ?
6 use base qw/Catalyst::Component Catalyst::AttrContainer/;
9 use Scalar::Util qw/blessed/;
10 use Catalyst::Exception;
19 predicate => 'has_path_prefix',
22 has action_namespace =>
26 init_arg => 'namespace',
27 predicate => 'has_action_namespace',
37 # isa => 'ClassName|Catalyst' ?
38 has _application => (is => 'rw');
39 sub _app{ shift->_application(@_) }
42 my ($self, $args) = @_;
43 my $action = delete $args->{action} || {};
44 my $actions = delete $args->{actions} || {};
45 my $attr_value = $self->merge_config_hashes($actions, $action);
46 $self->actions($attr_value);
51 Catalyst::Controller - Catalyst Controller base class
55 package MyApp::Controller::Search
56 use base qw/Catalyst::Controller/;
59 my ($self,$c,@args) = @_;
61 } # Dispatches to /search/foo
65 Controllers are where the actions in the Catalyst framework
66 reside. Each action is represented by a function with an attribute to
67 identify what kind of action it is. See the L<Catalyst::Dispatcher>
68 for more info about how Catalyst dispatches to actions.
72 #I think both of these could be attributes. doesn't really seem like they need
73 #to ble class data. i think that attributes +default would work just fine
74 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
76 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
77 __PACKAGE__->_action_class('Catalyst::Action');
80 sub _DISPATCH : Private {
81 my ( $self, $c ) = @_;
83 foreach my $disp ( @{ $self->_dispatch_steps } ) {
84 last unless $c->forward($disp);
90 sub _BEGIN : Private {
91 my ( $self, $c ) = @_;
92 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
93 return 1 unless $begin;
94 $begin->dispatch( $c );
95 return !@{ $c->error };
99 my ( $self, $c ) = @_;
100 my @auto = $c->get_actions( 'auto', $c->namespace );
101 foreach my $auto (@auto) {
102 $auto->dispatch( $c );
103 return 0 unless $c->state;
108 sub _ACTION : Private {
109 my ( $self, $c ) = @_;
111 && $c->action->can('execute')
114 $c->action->dispatch( $c );
116 return !@{ $c->error };
120 my ( $self, $c ) = @_;
121 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
122 return 1 unless $end;
123 $end->dispatch( $c );
124 return !@{ $c->error };
130 my $new = $self->next::method(@_);
131 $new->_application( $app );
136 my ( $self, $name ) = @_;
137 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
138 return $app->dispatcher->get_action($name, $self->action_namespace);
141 #my opinion is that this whole sub really should be a builder method, not
142 #something that happens on every call. Anyone else disagree?? -- groditi
144 #we are wrapping the accessor, so just uyse a modifier since a normal sub would
145 #just be overridden by the generated moose method
146 around action_namespace => sub {
148 my ( $self, $c ) = @_;
151 return $self->$orig if $self->has_action_namespace;
153 warn "action_namespace called as class method";
154 # if the following won't change at runtime it should be lazy_building thing
155 return $self->config->{namespace} if exists $self->config->{namespace};
158 #the following looks like a possible target for a default setting. i am not
159 #making the below the builder because i don't know if $c will vary from
160 #call to call, which would affect case sensitivity settings -- groditi
163 $case_s = $c->config->{case_sensitive};
165 if ($self->isa('Catalyst')) {
166 $case_s = $self->config->{case_sensitive};
169 $case_s = $self->_application->config->{case_sensitive};
171 confess("Can't figure out case_sensitive setting");
176 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
177 $self->$orig($namespace) if ref($self);
181 #Once again, this is probably better written as a builder method
182 around path_prefix => sub {
186 return $self->$orig if $self->has_path_prefix;
188 return $self->config->{path} if exists $self->config->{path};
190 my $namespace = $self->action_namespace(@_);
191 $self->$orig($namespace) if ref($self);
196 sub register_actions {
197 my ( $self, $c ) = @_;
198 my $class = ref $self || $self;
199 #this is still not correct for some reason.
200 my $namespace = $self->action_namespace($c);
201 my $meta = $self->meta;
202 my %methods = map{ $_->{code}->body => $_->{name} }
203 grep {$_->{class} ne 'Moose::Object'} #ignore Moose::Object methods
204 $meta->compute_all_applicable_methods;
207 # Advanced inheritance support for plugins and the like
208 #moose todo: migrate to eliminate CDI compat
210 for my $isa ( $meta->superclasses, $class ) {
211 if(my $coderef = $isa->can('_action_cache')){
212 push(@action_cache, @{ $isa->$coderef });
216 foreach my $cache (@action_cache) {
217 my $code = $cache->[0];
218 my $method = delete $methods{$code}; # avoid dupe registers
220 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
221 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
222 $c->log->debug( 'Bad action definition "'
223 . join( ' ', @{ $cache->[1] } )
224 . qq/" for "$class->$method"/ )
228 my $reverse = $namespace ? "${namespace}/${method}" : $method;
229 my $action = $self->create_action(
233 namespace => $namespace,
235 attributes => $attrs,
238 $c->dispatcher->register( $c, $action );
246 my $class = (exists $args{attributes}{ActionClass}
247 ? $args{attributes}{ActionClass}[0]
248 : $self->_action_class);
250 Class::MOP::load_class($class);
251 return $class->new( \%args );
255 my ( $self, $c, $name, @attrs ) = @_;
259 foreach my $attr (@attrs) {
261 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
263 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
266 if ( defined $value ) {
267 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
269 push( @{ $raw_attributes{$key} }, $value );
273 #I know that the original behavior was to ignore action if actions was set
274 # but i actually think this may be a little more sane? we can always remove
275 # the merge behavior quite easily and go back to having actions have
276 # presedence over action by modifying the keys. i honestly think this is
277 # superior while mantaining really high degree of compat
280 $actions = $self->actions;
282 my $cfg = $self->config;
283 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
286 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
288 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
291 my %final_attributes;
293 foreach my $key (keys %raw_attributes) {
295 my $raw = $raw_attributes{$key};
297 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
299 my $meth = "_parse_${key}_attr";
300 if ( my $code = $self->can($meth) ) {
301 ( $key, $value ) = $self->$code( $c, $name, $value );
303 push( @{ $final_attributes{$key} }, $value );
307 return \%final_attributes;
310 sub _parse_Global_attr {
311 my ( $self, $c, $name, $value ) = @_;
312 return $self->_parse_Path_attr( $c, $name, "/$name" );
315 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
317 sub _parse_Local_attr {
318 my ( $self, $c, $name, $value ) = @_;
319 return $self->_parse_Path_attr( $c, $name, $name );
322 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
324 sub _parse_Path_attr {
325 my ( $self, $c, $name, $value ) = @_;
327 if ( $value =~ m!^/! ) {
328 return ( 'Path', $value );
330 elsif ( length $value ) {
331 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
334 return ( 'Path', $self->path_prefix($c) );
338 sub _parse_Regex_attr {
339 my ( $self, $c, $name, $value ) = @_;
340 return ( 'Regex', $value );
343 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
345 sub _parse_LocalRegex_attr {
346 my ( $self, $c, $name, $value ) = @_;
347 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
348 return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" );
351 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
353 sub _parse_ActionClass_attr {
354 my ( $self, $c, $name, $value ) = @_;
355 unless ( $value =~ s/^\+// ) {
356 $value = join('::', $self->_action_class, $value );
358 return ( 'ActionClass', $value );
361 sub _parse_MyAction_attr {
362 my ( $self, $c, $name, $value ) = @_;
364 my $appclass = Catalyst::Utils::class2appclass($self);
365 $value = "${appclass}::Action::${value}";
367 return ( 'ActionClass', $value );
378 Like any other L<Catalyst::Component>, controllers have a config hash,
379 accessible through $self->config from the controller actions. Some
380 settings are in use by the Catalyst framework:
384 This specifies the internal namespace the controller should be bound
385 to. By default the controller is bound to the URI version of the
386 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
387 will be bound to 'foo/bar'. The default Root controller is an example
388 of setting namespace to '' (the null string).
392 Sets 'path_prefix', as described below.
396 =head2 $class->new($app, @args)
398 Proxies through to NEXT::new and stashes the application instance as
401 =head2 $self->action_for('name')
403 Returns the Catalyst::Action object (if any) for a given method name
406 =head2 $self->register_actions($c)
408 Finds all applicable actions for this component, creates
409 Catalyst::Action objects (using $self->create_action) for them and
410 registers them with $c->dispatcher.
412 =head2 $self->action_namespace($c)
414 Returns the private namespace for actions in this component. Defaults
415 to a value from the controller name (for
416 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
417 overridden from the "namespace" config key.
420 =head2 $self->path_prefix($c)
422 Returns the default path prefix for :Local, :LocalRegex and relative
423 :Path actions in this component. Defaults to the action_namespace or
424 can be overridden from the "path" config key.
426 =head2 $self->create_action(%args)
428 Called with a hash of data to be use for construction of a new
429 Catalyst::Action (or appropriate sub/alternative class) object.
431 Primarily designed for the use of register_actions.
433 =head2 $self->_application
437 Returns the application instance stored by C<new()>
441 Sebastian Riedel, C<sri@oook.de>
442 Marcus Ramberg C<mramberg@cpan.org>
446 This program is free software, you can redistribute it and/or modify
447 it under the same terms as Perl itself.