1 package Catalyst::Controller;
5 #use MooseX::ClassAttribute;
6 use Catalyst::Exception;
11 #extends qw/Catalyst::Component Catalyst::AttrContainer/;
12 use base qw/Catalyst::Component Catalyst::AttrContainer/;
14 # class_has _dispatch_steps =>
19 # default => sub{ [qw/_BEGIN _AUTO _ACTION/] },
22 # class_has _action_class =>
27 # default => sub{ 'Catalyst::Action' },
30 __PACKAGE__->mk_classdata('_dispatch_steps');
31 __PACKAGE__->mk_classdata('_action_class');
33 __PACKAGE__->_action_class('Catalyst::Action');
34 __PACKAGE__->_dispatch_steps([qw/_BEGIN _AUTO _ACTION/]);
37 has _application => ( is => 'rw' );
39 *_app = *_application;
43 Catalyst::Controller - Catalyst Controller base class
47 package MyApp::Controller::Search
48 use base qw/Catalyst::Controller/;
51 my ($self,$c,@args) = @_;
53 } # Dispatches to /search/foo
57 Controllers are where the actions in the Catalyst framework
58 reside. Each action is represented by a function with an attribute to
59 identify what kind of action it is. See the L<Catalyst::Dispatcher>
60 for more info about how Catalyst dispatches to actions.
64 # just emulating old behavior. we could probably do this
65 # via BUILD later or pass $app as application => $app
70 my $new = $self->$orig(@_);
71 $new->_application( $app );
76 sub _DISPATCH : Private {
77 my ( $self, $c ) = @_;
79 foreach my $disp ( @{ $self->_dispatch_steps } ) {
80 last unless $c->forward($disp);
86 sub _BEGIN : Private {
87 my ( $self, $c ) = @_;
88 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
89 return 1 unless $begin;
90 $begin->dispatch( $c );
91 return !@{ $c->error };
95 my ( $self, $c ) = @_;
96 my @auto = $c->get_actions( 'auto', $c->namespace );
97 foreach my $auto (@auto) {
98 $auto->dispatch( $c );
99 return 0 unless $c->state;
104 sub _ACTION : Private {
105 my ( $self, $c ) = @_;
107 && $c->action->can('execute')
110 $c->action->dispatch( $c );
112 return !@{ $c->error };
116 my ( $self, $c ) = @_;
117 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
118 return 1 unless $end;
119 $end->dispatch( $c );
120 return !@{ $c->error };
124 my ( $self, $name ) = @_;
125 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
126 return $app->dispatcher->get_action($name, $self->action_namespace);
129 sub action_namespace {
130 my ( $self, $c ) = @_;
132 $c = ($self->isa('Catalyst') ? $self : $self->_application);
134 my $hash = (ref $self ? $self : $self->config); # hate app-is-class
135 return $hash->{namespace} if exists $hash->{namespace};
136 return Catalyst::Utils::class2prefix( ref($self) || $self,
137 $c->config->{case_sensitive} )
142 my ( $self, $c ) = @_;
144 $c = ($self->isa('Catalyst') ? $self : $self->_application);
146 my $hash = (ref $self ? $self : $self->config); # hate app-is-class
147 return $hash->{path} if exists $hash->{path};
148 return shift->action_namespace(@_);
152 sub register_actions {
153 my ( $self, $c ) = @_;
154 my $class = ref $self || $self;
155 my $namespace = $self->action_namespace($c);
158 my $meth_map = $class->meta->get_method_map;
159 @methods{values %$meth_map} = (keys %$meth_map);
162 #Moose TODO: something tells me that roles could kill the directly code below
163 # Advanced inheritance support for plugins and the like
167 for my $isa ( @{"$class\::ISA"}, $class ) {
168 push @action_cache, @{ $isa->_action_cache }
169 if $isa->can('_action_cache');
173 foreach my $cache (@action_cache) {
174 my $code = $cache->[0];
175 my $method = delete $methods{$code}; # avoid dupe registers
177 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
178 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
179 $c->log->debug( 'Bad action definition "'
180 . join( ' ', @{ $cache->[1] } )
181 . qq/" for "$class->$method"/ )
185 my $reverse = $namespace ? "$namespace/$method" : $method;
186 my $action = $self->create_action(
190 namespace => $namespace,
192 attributes => $attrs,
195 $c->dispatcher->register( $c, $action );
203 my $class = (exists $args{attributes}{ActionClass}
204 ? $args{attributes}{ActionClass}[0]
205 : $self->_action_class);
207 #can we replace with a single call to Class::MOP::load_class() ?
208 #unless ( Class::Inspector->loaded($class) ) {
209 # require Class::Inspector->filename($class);
211 Class::MOP::load_class($class);
213 return $class->new( \%args );
217 my ( $self, $c, $name, @attrs ) = @_;
221 foreach my $attr (@attrs) {
223 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
225 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
228 if ( defined $value ) {
229 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
231 push( @{ $raw_attributes{$key} }, $value );
235 my $hash = (ref $self ? $self : $self->config); # hate app-is-class
237 if (exists $hash->{actions} || exists $hash->{action}) {
238 my $a = $hash->{actions} || $hash->{action};
239 %raw_attributes = ((exists $a->{'*'} ? %{$a->{'*'}} : ()),
241 (exists $a->{$name} ? %{$a->{$name}} : ()));
244 my %final_attributes;
246 foreach my $key (keys %raw_attributes) {
248 my $raw = $raw_attributes{$key};
250 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
252 my $meth = "_parse_${key}_attr";
253 if ( $self->can($meth) ) {
254 ( $key, $value ) = $self->$meth( $c, $name, $value );
256 push( @{ $final_attributes{$key} }, $value );
260 return \%final_attributes;
263 sub _parse_Global_attr {
264 my ( $self, $c, $name, $value ) = @_;
265 return $self->_parse_Path_attr( $c, $name, "/$name" );
268 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
270 sub _parse_Local_attr {
271 my ( $self, $c, $name, $value ) = @_;
272 return $self->_parse_Path_attr( $c, $name, $name );
275 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
277 sub _parse_Path_attr {
278 my ( $self, $c, $name, $value ) = @_;
280 if ( $value =~ m!^/! ) {
281 return ( 'Path', $value );
283 elsif ( length $value ) {
284 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
287 return ( 'Path', $self->path_prefix($c) );
291 sub _parse_Regex_attr {
292 my ( $self, $c, $name, $value ) = @_;
293 return ( 'Regex', $value );
296 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
298 sub _parse_LocalRegex_attr {
299 my ( $self, $c, $name, $value ) = @_;
300 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
301 return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" );
304 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
306 sub _parse_ActionClass_attr {
307 my ( $self, $c, $name, $value ) = @_;
308 unless ( $value =~ s/^\+// ) {
309 $value = join('::', $self->_action_class, $value );
311 return ( 'ActionClass', $value );
314 sub _parse_MyAction_attr {
315 my ( $self, $c, $name, $value ) = @_;
317 my $appclass = Catalyst::Utils::class2appclass($self);
318 $value = "${appclass}::Action::${value}";
320 return ( 'ActionClass', $value );
329 Like any other L<Catalyst::Component>, controllers have a config hash,
330 accessible through $self->config from the controller actions. Some
331 settings are in use by the Catalyst framework:
335 This specifies the internal namespace the controller should be bound
336 to. By default the controller is bound to the URI version of the
337 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
338 will be bound to 'foo/bar'. The default Root controller is an example
339 of setting namespace to '' (the null string).
343 Sets 'path_prefix', as described below.
347 =head2 $class->new($app, @args)
349 Proxies through to NEXT::new and stashes the application instance as
352 =head2 $self->action_for('name')
354 Returns the Catalyst::Action object (if any) for a given method name
357 =head2 $self->register_actions($c)
359 Finds all applicable actions for this component, creates
360 Catalyst::Action objects (using $self->create_action) for them and
361 registers them with $c->dispatcher.
363 =head2 $self->action_namespace($c)
365 Returns the private namespace for actions in this component. Defaults
366 to a value from the controller name (for
367 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
368 overridden from the "namespace" config key.
371 =head2 $self->path_prefix($c)
373 Returns the default path prefix for :Local, :LocalRegex and relative
374 :Path actions in this component. Defaults to the action_namespace or
375 can be overridden from the "path" config key.
377 =head2 $self->create_action(%args)
379 Called with a hash of data to be use for construction of a new
380 Catalyst::Action (or appropriate sub/alternative class) object.
382 Primarily designed for the use of register_actions.
384 =head2 $self->_application
388 Returns the application instance stored by C<new()>
392 Sebastian Riedel, C<sri@oook.de>
393 Marcus Ramberg C<mramberg@cpan.org>
397 This program is free software, you can redistribute it and/or modify
398 it under the same terms as Perl itself.