removed commented code
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Controller.pm
CommitLineData
5ee249f2 1package Catalyst::Controller;
2
ae29b412 3use Moose;
a58af53d 4use Moose::Util qw/find_meta/;
ae29b412 5
6use namespace::clean -except => 'meta';
7
ba545c13 8BEGIN { extends qw/Catalyst::Component MooseX::MethodAttributes::Inheritable/; }
234763d4 9
cf37d21a 10use MooseX::MethodAttributes;
234763d4 11use Catalyst::Exception;
12use Catalyst::Utils;
ae29b412 13
14with 'Catalyst::Component::ApplicationAttribute';
15
16has path_prefix =>
17 (
18 is => 'rw',
19 isa => 'Str',
7f22a5aa 20 init_arg => 'path',
ae29b412 21 predicate => 'has_path_prefix',
22 );
23
24has action_namespace =>
25 (
26 is => 'rw',
27 isa => 'Str',
7f22a5aa 28 init_arg => 'namespace',
ae29b412 29 predicate => 'has_action_namespace',
30 );
31
637be086 32has _controller_actions =>
ae29b412 33 (
34 is => 'rw',
35 isa => 'HashRef',
7f22a5aa 36 init_arg => undef,
ae29b412 37 );
38
7f22a5aa 39sub BUILD {
40 my ($self, $args) = @_;
ae29b412 41 my $action = delete $args->{action} || {};
42 my $actions = delete $args->{actions} || {};
7f22a5aa 43 my $attr_value = $self->merge_config_hashes($actions, $action);
44 $self->_controller_actions($attr_value);
45}
5ee249f2 46
47=head1 NAME
48
49Catalyst::Controller - Catalyst Controller base class
50
51=head1 SYNOPSIS
52
234763d4 53 package MyApp::Controller::Search
a269e0c2 54 use base qw/Catalyst::Controller/;
234763d4 55
27ae4114 56 sub foo : Local {
85d9fce6 57 my ($self,$c,@args) = @_;
27ae4114 58 ...
234763d4 59 } # Dispatches to /search/foo
5ee249f2 60
61=head1 DESCRIPTION
62
a269e0c2 63Controllers are where the actions in the Catalyst framework
64reside. Each action is represented by a function with an attribute to
65identify what kind of action it is. See the L<Catalyst::Dispatcher>
66for more info about how Catalyst dispatches to actions.
234763d4 67
68=cut
69
ae29b412 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
234763d4 72__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
73
74__PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
75__PACKAGE__->_action_class('Catalyst::Action');
76
234763d4 77
78sub _DISPATCH : Private {
79 my ( $self, $c ) = @_;
80
81 foreach my $disp ( @{ $self->_dispatch_steps } ) {
82 last unless $c->forward($disp);
83 }
84
85 $c->forward('_END');
86}
87
88sub _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 };
94}
95
96sub _AUTO : Private {
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;
102 }
103 return 1;
104}
105
106sub _ACTION : Private {
107 my ( $self, $c ) = @_;
108 if ( ref $c->action
109 && $c->action->can('execute')
53119b78 110 && defined $c->req->action )
234763d4 111 {
112 $c->action->dispatch( $c );
113 }
114 return !@{ $c->error };
115}
116
117sub _END : Private {
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 };
123}
124
234763d4 125sub action_for {
126 my ( $self, $name ) = @_;
127 my $app = ($self->isa('Catalyst') ? $self : $self->_application);
128 return $app->dispatcher->get_action($name, $self->action_namespace);
129}
130
27ae4114 131#my opinion is that this whole sub really should be a builder method, not
ae29b412 132#something that happens on every call. Anyone else disagree?? -- groditi
133## -- apparently this is all just waiting for app/ctx split
134around action_namespace => sub {
135 my $orig = shift;
234763d4 136 my ( $self, $c ) = @_;
ae29b412 137
138 if( ref($self) ){
139 return $self->$orig if $self->has_action_namespace;
140 } else {
141 return $self->config->{namespace} if exists $self->config->{namespace};
234763d4 142 }
234763d4 143
ae29b412 144 my $case_s;
145 if( $c ){
146 $case_s = $c->config->{case_sensitive};
147 } else {
148 if ($self->isa('Catalyst')) {
149 $case_s = $self->config->{case_sensitive};
150 } else {
151 if (ref $self) {
152 $case_s = $self->_application->config->{case_sensitive};
153 } else {
154 confess("Can't figure out case_sensitive setting");
155 }
156 }
234763d4 157 }
ae29b412 158
159 my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $case_s) || '';
160 $self->$orig($namespace) if ref($self);
161 return $namespace;
162};
163
164#Once again, this is probably better written as a builder method
165around path_prefix => sub {
166 my $orig = shift;
167 my $self = shift;
168 if( ref($self) ){
169 return $self->$orig if $self->has_path_prefix;
170 } else {
171 return $self->config->{path} if exists $self->config->{path};
172 }
173 my $namespace = $self->action_namespace(@_);
174 $self->$orig($namespace) if ref($self);
175 return $namespace;
176};
234763d4 177
9ab7d83d 178sub get_action_methods {
179 my $self = shift;
180 my $meta = find_meta($self);
fa649eb7 181 confess("Metaclass for "
182 . ref($meta) . " for "
183 . $meta->name
184 . " cannot support register_actions." )
185 unless $meta->can('get_nearest_methods_with_attributes');
cf37d21a 186 my @methods = $meta->get_nearest_methods_with_attributes;
fa649eb7 187
188 # actions specified via config are also action_methods
189 push(
190 @methods,
191 map {
192 $meta->get_method($_)
193 || confess( 'Action "'
194 . $_
195 . '" is not available from controller '
196 . ( ref $self ) )
197 } keys %{ $self->_controller_actions }
198 ) if ( ref $self );
9ab7d83d 199 return @methods;
200}
234763d4 201
fa649eb7 202
234763d4 203sub register_actions {
204 my ( $self, $c ) = @_;
9ab7d83d 205 $self->register_action_methods( $c, $self->get_action_methods );
206}
207
208sub register_action_methods {
209 my ( $self, $c, @methods ) = @_;
234763d4 210 my $class = ref $self || $self;
ae29b412 211 #this is still not correct for some reason.
234763d4 212 my $namespace = $self->action_namespace($c);
234763d4 213
ba545c13 214 foreach my $method (@methods) {
215 my $name = $method->name;
216 my $attributes = $method->attributes;
ba545c13 217 my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
234763d4 218 if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
219 $c->log->debug( 'Bad action definition "'
ba545c13 220 . join( ' ', @{ $attributes } )
221 . qq/" for "$class->$name"/ )
234763d4 222 if $c->debug;
223 next;
224 }
bc677969 225 my $reverse = $namespace ? "${namespace}/${name}" : $name;
234763d4 226 my $action = $self->create_action(
ba545c13 227 name => $name,
228 code => $method->body,
234763d4 229 reverse => $reverse,
230 namespace => $namespace,
231 class => $class,
232 attributes => $attrs,
233 );
234
235 $c->dispatcher->register( $c, $action );
236 }
237}
238
239sub create_action {
240 my $self = shift;
241 my %args = @_;
242
243 my $class = (exists $args{attributes}{ActionClass}
244 ? $args{attributes}{ActionClass}[0]
245 : $self->_action_class);
246
ae29b412 247 Class::MOP::load_class($class);
234763d4 248 return $class->new( \%args );
249}
250
251sub _parse_attrs {
252 my ( $self, $c, $name, @attrs ) = @_;
253
254 my %raw_attributes;
255
256 foreach my $attr (@attrs) {
257
258 # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
259
260 if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
261 {
262
263 if ( defined $value ) {
264 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
265 }
266 push( @{ $raw_attributes{$key} }, $value );
267 }
268 }
269
ae29b412 270 #I know that the original behavior was to ignore action if actions was set
271 # but i actually think this may be a little more sane? we can always remove
272 # the merge behavior quite easily and go back to having actions have
273 # presedence over action by modifying the keys. i honestly think this is
274 # superior while mantaining really high degree of compat
275 my $actions;
276 if( ref($self) ) {
637be086 277 $actions = $self->_controller_actions;
ae29b412 278 } else {
279 my $cfg = $self->config;
280 $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
234763d4 281 }
282
ae29b412 283 %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
284 %raw_attributes,
285 (exists $actions->{$name} ? %{$actions->{$name}} : ()));
286
287
234763d4 288 my %final_attributes;
289
290 foreach my $key (keys %raw_attributes) {
291
292 my $raw = $raw_attributes{$key};
293
294 foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
295
296 my $meth = "_parse_${key}_attr";
ae29b412 297 if ( my $code = $self->can($meth) ) {
298 ( $key, $value ) = $self->$code( $c, $name, $value );
234763d4 299 }
300 push( @{ $final_attributes{$key} }, $value );
301 }
302 }
303
304 return \%final_attributes;
305}
306
307sub _parse_Global_attr {
308 my ( $self, $c, $name, $value ) = @_;
309 return $self->_parse_Path_attr( $c, $name, "/$name" );
310}
311
312sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
313
314sub _parse_Local_attr {
315 my ( $self, $c, $name, $value ) = @_;
316 return $self->_parse_Path_attr( $c, $name, $name );
317}
318
319sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
320
321sub _parse_Path_attr {
322 my ( $self, $c, $name, $value ) = @_;
53119b78 323 $value = '' if !defined $value;
234763d4 324 if ( $value =~ m!^/! ) {
325 return ( 'Path', $value );
326 }
327 elsif ( length $value ) {
328 return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
329 }
330 else {
331 return ( 'Path', $self->path_prefix($c) );
332 }
333}
334
335sub _parse_Regex_attr {
336 my ( $self, $c, $name, $value ) = @_;
337 return ( 'Regex', $value );
338}
339
340sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
341
342sub _parse_LocalRegex_attr {
343 my ( $self, $c, $name, $value ) = @_;
344 unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
19c01ee1 345
346 my $prefix = $self->path_prefix( $c );
347 $prefix .= '/' if length( $prefix );
27ae4114 348
19c01ee1 349 return ( 'Regex', "^${prefix}${value}" );
234763d4 350}
351
352sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
353
f3107403 354sub _parse_Chained_attr {
355 my ($self, $c, $name, $value) = @_;
356
357 if (defined($value) && length($value)) {
358 if ($value eq '.') {
359 $value = '/'.$self->action_namespace($c);
fb56008f 360 } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
eb270c30 361 my @parts = split '/', $self->action_namespace($c);
fb56008f 362 my @levels = split '/', $rel;
363
364 $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
f3107403 365 } elsif ($value !~ m/^\//) {
366 my $action_ns = $self->action_namespace($c);
367
368 if ($action_ns) {
369 $value = '/'.join('/', $action_ns, $value);
370 } else {
371 $value = '/'.$value; # special case namespace '' (root)
372 }
373 }
374 } else {
375 $value = '/'
376 }
377
378 return Chained => $value;
379}
380
9356b981 381sub _parse_ChainedParent_attr {
382 my ($self, $c, $name, $value) = @_;
383 return $self->_parse_Chained_attr($c, $name, '../'.$name);
384}
385
e5d2cfdb 386sub _parse_PathPrefix_attr {
387 my $self = shift;
388 return PathPart => $self->path_prefix;
389}
390
234763d4 391sub _parse_ActionClass_attr {
392 my ( $self, $c, $name, $value ) = @_;
17b3d800 393 $value = Catalyst::Utils::resolve_namespace($self->_action_class, $value);
234763d4 394 return ( 'ActionClass', $value );
395}
396
9287719b 397sub _parse_MyAction_attr {
398 my ( $self, $c, $name, $value ) = @_;
399
400 my $appclass = Catalyst::Utils::class2appclass($self);
401 $value = "${appclass}::Action::${value}";
234763d4 402
9287719b 403 return ( 'ActionClass', $value );
404}
234763d4 405
ae29b412 406__PACKAGE__->meta->make_immutable;
407
234763d4 4081;
409
410__END__
411
412=head1 CONFIGURATION
413
a269e0c2 414Like any other L<Catalyst::Component>, controllers have a config hash,
415accessible through $self->config from the controller actions. Some
416settings are in use by the Catalyst framework:
234763d4 417
418=head2 namespace
419
a269e0c2 420This specifies the internal namespace the controller should be bound
421to. By default the controller is bound to the URI version of the
422controller name. For instance controller 'MyApp::Controller::Foo::Bar'
423will be bound to 'foo/bar'. The default Root controller is an example
424of setting namespace to '' (the null string).
234763d4 425
27ae4114 426=head2 path
234763d4 427
428Sets 'path_prefix', as described below.
429
430=head1 METHODS
431
c4d02967 432=head2 BUILDARGS ($app, @args)
234763d4 433
c4d02967 434From L<Catalyst::Component::ApplicationAttribute>, stashes the application
435instance as $self->_application.
234763d4 436
437=head2 $self->action_for('name')
438
a269e0c2 439Returns the Catalyst::Action object (if any) for a given method name
440in this component.
234763d4 441
234763d4 442=head2 $self->action_namespace($c)
443
a269e0c2 444Returns the private namespace for actions in this component. Defaults
445to a value from the controller name (for
446e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
447overridden from the "namespace" config key.
234763d4 448
449
450=head2 $self->path_prefix($c)
451
e5d2cfdb 452Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
453relative :Path actions in this component. Defaults to the action_namespace or
a269e0c2 454can be overridden from the "path" config key.
234763d4 455
c4d02967 456=head2 $self->register_actions($c)
457
458Finds all applicable actions for this component, creates
459Catalyst::Action objects (using $self->create_action) for them and
460registers them with $c->dispatcher.
461
462=head2 $self->get_action_methods()
463
464Returns a list of L<Moose::Meta::Method> objects, doing the
465L<MooseX::MethodAttributes::Role::Meta::Method> role, which are the set of
466action methods for this package.
467
468=head2 $self->register_action_methods($c, @methods)
469
470Creates action objects for a set of action methods using C< create_action >,
471and registers them with the dispatcher.
472
234763d4 473=head2 $self->create_action(%args)
474
a269e0c2 475Called with a hash of data to be use for construction of a new
476Catalyst::Action (or appropriate sub/alternative class) object.
234763d4 477
a269e0c2 478=head2 $self->_application
234763d4 479
480=head2 $self->_app
481
482Returns the application instance stored by C<new()>
5ee249f2 483
0bf7ab71 484=head1 AUTHORS
5ee249f2 485
0bf7ab71 486Catalyst Contributors, see Catalyst.pm
5ee249f2 487
488=head1 COPYRIGHT
489
a269e0c2 490This program is free software, you can redistribute it and/or modify
491it under the same terms as Perl itself.
5ee249f2 492
493=cut