1 package Catalyst::Controller;
5 use base qw/Catalyst::Component Catalyst::AttrContainer/;
7 #Why does the following blow up?
8 #extends qw/Catalyst::Component Catalyst::AttrContainer/;
13 predicate => 'has_path',
16 #this are frefixed like this because _namespace clases with something in
17 #Catalyst.pm . to be fixed later.
21 init_arg => 'namespace',
22 predicate => '_has_namespace',
25 __PACKAGE__->mk_accessors( qw/_application/ );
27 has _application => (is => 'rw');
28 sub _app{ shift->_application(@_) } # eww
30 use Scalar::Util qw/blessed/;
31 use Catalyst::Exception;
37 Catalyst::Controller - Catalyst Controller base class
41 package MyApp::Controller::Search
42 use base qw/Catalyst::Controller/;
45 my ($self,$c,@args) = @_;
47 } # Dispatches to /search/foo
51 Controllers are where the actions in the Catalyst framework
52 reside. Each action is represented by a function with an attribute to
53 identify what kind of action it is. See the L<Catalyst::Dispatcher>
54 for more info about how Catalyst dispatches to actions.
58 #I think both of these could be attributes. doesn't really seem like they need
59 #to ble class data. i think that attributes +default would work just fine
60 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
62 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
63 __PACKAGE__->_action_class('Catalyst::Action');
66 sub _DISPATCH : Private {
67 my ( $self, $c ) = @_;
69 foreach my $disp ( @{ $self->_dispatch_steps } ) {
70 last unless $c->forward($disp);
76 sub _BEGIN : Private {
77 my ( $self, $c ) = @_;
78 my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
79 return 1 unless $begin;
80 $begin->dispatch( $c );
81 return !@{ $c->error };
85 my ( $self, $c ) = @_;
86 my @auto = $c->get_actions( 'auto', $c->namespace );
87 foreach my $auto (@auto) {
88 $auto->dispatch( $c );
89 return 0 unless $c->state;
94 sub _ACTION : Private {
95 my ( $self, $c ) = @_;
97 && $c->action->can('execute')
100 $c->action->dispatch( $c );
102 return !@{ $c->error };
106 my ( $self, $c ) = @_;
107 my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
108 return 1 unless $end;
109 $end->dispatch( $c );
110 return !@{ $c->error };
117 my $new = $self->$orig(@_);
118 $new->_application( $app );
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);
135 return $self->_namespace if $self->_has_namespace;
136 } # else { #i think this is hacky and it should work with the else enabled
137 return $self->config->{namespace} if exists $self->config->{namespace};
139 return Catalyst::Utils::class2prefix( ref($self) || $self,
140 $c->config->{case_sensitive} )
145 my ( $self, $c ) = @_;
147 $c = ($self->isa('Catalyst') ? $self : $self->_application);
150 return $self->path if $self->has_path;
152 return $self->config->{path} if exists $self->config->{path};
154 return shift->action_namespace(@_);
158 sub register_actions {
159 my ( $self, $c ) = @_;
160 my $class = ref $self || $self;
161 #this is still not correct for some reason.
162 my $namespace = $self->action_namespace($c);
164 if( $self->can('meta') ){
165 my $meta = $self->meta;
166 %methods = map{ $_->{code}->body => $_->{name} }
167 grep {$_->{class} ne 'Moose::Object'} #ignore Moose::Object methods
168 $meta->compute_all_applicable_methods;
169 } else { #until we are sure there's no moose stuff left...
170 $methods{ $self->can($_) } = $_
171 for @{ Class::Inspector->methods($class) || [] };
174 # Advanced inheritance support for plugins and the like
175 #to be modified to use meta->superclasses
179 for my $isa ( @{"$class\::ISA"}, $class ) {
180 push @action_cache, @{ $isa->_action_cache }
181 if $isa->can('_action_cache');
185 foreach my $cache (@action_cache) {
186 my $code = $cache->[0];
187 my $method = delete $methods{$code}; # avoid dupe registers
189 my $attrs = $self->_parse_attrs( $c, $method, @{ $cache->[1] } );
190 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
191 $c->log->debug( 'Bad action definition "'
192 . join( ' ', @{ $cache->[1] } )
193 . qq/" for "$class->$method"/ )
197 my $reverse = $namespace ? "${namespace}/${method}" : $method;
198 my $action = $self->create_action(
202 namespace => $namespace,
204 attributes => $attrs,
207 $c->dispatcher->register( $c, $action );
215 my $class = (exists $args{attributes}{ActionClass}
216 ? $args{attributes}{ActionClass}[0]
217 : $self->_action_class);
219 Class::MOP::load_class($class);
220 #unless ( Class::Inspector->loaded($class) ) {
221 # require Class::Inspector->filename($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 #this will not work under moose
247 #my $hash = (ref $self ? $self : $self->config); # hate app-is-class
248 #action / actions should be an attribute of Controller
249 my $hash = $self->config;
251 if (exists $hash->{actions} || exists $hash->{action}) {
252 my $a = $hash->{actions} || $hash->{action};
253 %raw_attributes = ((exists $a->{'*'} ? %{$a->{'*'}} : ()),
255 (exists $a->{$name} ? %{$a->{$name}} : ()));
258 my %final_attributes;
260 foreach my $key (keys %raw_attributes) {
262 my $raw = $raw_attributes{$key};
264 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
266 my $meth = "_parse_${key}_attr";
267 if ( $self->can($meth) ) {
268 ( $key, $value ) = $self->$meth( $c, $name, $value );
270 push( @{ $final_attributes{$key} }, $value );
274 return \%final_attributes;
277 sub _parse_Global_attr {
278 my ( $self, $c, $name, $value ) = @_;
279 return $self->_parse_Path_attr( $c, $name, "/$name" );
282 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
284 sub _parse_Local_attr {
285 my ( $self, $c, $name, $value ) = @_;
286 return $self->_parse_Path_attr( $c, $name, $name );
289 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
291 sub _parse_Path_attr {
292 my ( $self, $c, $name, $value ) = @_;
294 if ( $value =~ m!^/! ) {
295 return ( 'Path', $value );
297 elsif ( length $value ) {
298 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
301 return ( 'Path', $self->path_prefix($c) );
305 sub _parse_Regex_attr {
306 my ( $self, $c, $name, $value ) = @_;
307 return ( 'Regex', $value );
310 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
312 sub _parse_LocalRegex_attr {
313 my ( $self, $c, $name, $value ) = @_;
314 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
315 return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" );
318 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
320 sub _parse_ActionClass_attr {
321 my ( $self, $c, $name, $value ) = @_;
322 unless ( $value =~ s/^\+// ) {
323 $value = join('::', $self->_action_class, $value );
325 return ( 'ActionClass', $value );
328 sub _parse_MyAction_attr {
329 my ( $self, $c, $name, $value ) = @_;
331 my $appclass = Catalyst::Utils::class2appclass($self);
332 $value = "${appclass}::Action::${value}";
334 return ( 'ActionClass', $value );
343 Like any other L<Catalyst::Component>, controllers have a config hash,
344 accessible through $self->config from the controller actions. Some
345 settings are in use by the Catalyst framework:
349 This specifies the internal namespace the controller should be bound
350 to. By default the controller is bound to the URI version of the
351 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
352 will be bound to 'foo/bar'. The default Root controller is an example
353 of setting namespace to '' (the null string).
357 Sets 'path_prefix', as described below.
361 =head2 $class->new($app, @args)
363 Proxies through to NEXT::new and stashes the application instance as
366 =head2 $self->action_for('name')
368 Returns the Catalyst::Action object (if any) for a given method name
371 =head2 $self->register_actions($c)
373 Finds all applicable actions for this component, creates
374 Catalyst::Action objects (using $self->create_action) for them and
375 registers them with $c->dispatcher.
377 =head2 $self->action_namespace($c)
379 Returns the private namespace for actions in this component. Defaults
380 to a value from the controller name (for
381 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
382 overridden from the "namespace" config key.
385 =head2 $self->path_prefix($c)
387 Returns the default path prefix for :Local, :LocalRegex and relative
388 :Path actions in this component. Defaults to the action_namespace or
389 can be overridden from the "path" config key.
391 =head2 $self->create_action(%args)
393 Called with a hash of data to be use for construction of a new
394 Catalyst::Action (or appropriate sub/alternative class) object.
396 Primarily designed for the use of register_actions.
398 =head2 $self->_application
402 Returns the application instance stored by C<new()>
406 Sebastian Riedel, C<sri@oook.de>
407 Marcus Ramberg C<mramberg@cpan.org>
411 This program is free software, you can redistribute it and/or modify
412 it under the same terms as Perl itself.