lib/Catalyst/Controller.pm

   1 package Catalyst::Controller;
   2
   3 use Moose;
   4 use Class::MOP ();
   5 #use MooseX::ClassAttribute;
   6 use Catalyst::Exception;
   7 use Catalyst::Utils;
   8 use Class::Inspector;
   9 use NEXT;
  10
  11 #extends qw/Catalyst::Component Catalyst::AttrContainer/;
  12 use base qw/Catalyst::Component Catalyst::AttrContainer/;
  13
  14 # class_has _dispatch_steps =>
  15 #   (
  16 #    is => 'rw',
  17 #    isa => 'ArrayRef',
  18 #    required => 1,
  19 #    default => sub{ [qw/_BEGIN _AUTO _ACTION/] },
  20 #   );
  21
  22 # class_has _action_class =>
  23 #   (
  24 #    is => 'rw',
  25 #    isa => 'ClassName',
  26 #    required => 1,
  27 #    default => sub{ 'Catalyst::Action' },
  28 #   );
  29
  30 __PACKAGE__->mk_classdata('_dispatch_steps');
  31 __PACKAGE__->mk_classdata('_action_class');
  32
  33 __PACKAGE__->_action_class('Catalyst::Action');
  34 __PACKAGE__->_dispatch_steps([qw/_BEGIN _AUTO _ACTION/]);
  35
  36
  37 has _application => ( is => 'rw' );
  38 ### _app as alias
  39 *_app = *_application;
  40
  41 =head1 NAME
  42
  43 Catalyst::Controller - Catalyst Controller base class
  44
  45 =head1 SYNOPSIS
  46
  47   package MyApp::Controller::Search
  48   use base qw/Catalyst::Controller/;
  49
  50   sub foo : Local {
  51     my ($self,$c,@args) = @_;
  52     ...
  53   } # Dispatches to /search/foo
  54
  55 =head1 DESCRIPTION
  56
  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.
  61
  62 =cut
  63
  64 # just emulating old behavior. we could probably do this
  65 # via BUILD later or pass $app as application => $app
  66 around new => sub {
  67     my $orig = shift;
  68     my $self = shift;
  69     my $app = $_[0];
  70     my $new = $self->$orig(@_);
  71     $new->_application( $app );
  72     return $new;
  73 };
  74
  75
  76 sub _DISPATCH : Private {
  77     my ( $self, $c ) = @_;
  78
  79     foreach my $disp ( @{ $self->_dispatch_steps } ) {
  80         last unless $c->forward($disp);
  81     }
  82
  83     $c->forward('_END');
  84 }
  85
  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 };
  92 }
  93
  94 sub _AUTO : Private {
  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;
 100     }
 101     return 1;
 102 }
 103
 104 sub _ACTION : Private {
 105     my ( $self, $c ) = @_;
 106     if (   ref $c->action
 107         && $c->action->can('execute')
 108         && $c->req->action )
 109     {
 110         $c->action->dispatch( $c );
 111     }
 112     return !@{ $c->error };
 113 }
 114
 115 sub _END : Private {
 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 };
 121 }
 122
 123 sub action_for {
 124     my ( $self, $name ) = @_;
 125     my $app = ($self->isa('Catalyst') ? $self : $self->_application);
 126     return $app->dispatcher->get_action($name, $self->action_namespace);
 127 }
 128
 129 sub action_namespace {
 130     my ( $self, $c ) = @_;
 131     unless ( $c ) {
 132         $c = ($self->isa('Catalyst') ? $self : $self->_application);
 133     }
 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} )
 138       || '';
 139 }
 140
 141 sub path_prefix {
 142     my ( $self, $c ) = @_;
 143     unless ( $c ) {
 144         $c = ($self->isa('Catalyst') ? $self : $self->_application);
 145     }
 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(@_);
 149 }
 150
 151
 152 sub register_actions {
 153     my ( $self, $c ) = @_;
 154     my $class = ref $self || $self;
 155     my $namespace = $self->action_namespace($c);
 156     my %methods;
 157     {
 158       my $meth_map = $class->meta->get_method_map;
 159       @methods{values %$meth_map} = (keys %$meth_map);
 160     }
 161
 162     #Moose TODO: something tells me that roles could kill the directly code below
 163     # Advanced inheritance support for plugins and the like
 164     my @action_cache;
 165     {
 166         no strict 'refs';
 167         for my $isa ( @{"$class\::ISA"}, $class ) {
 168             push @action_cache, @{ $isa->_action_cache }
 169               if $isa->can('_action_cache');
 170         }
 171     }
 172
 173     foreach my $cache (@action_cache) {
 174         my $code   = $cache->[0];
 175         my $method = delete $methods{$code}; # avoid dupe registers
 176         next unless $method;
 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"/ )
 182               if $c->debug;
 183             next;
 184         }
 185         my $reverse = $namespace ? "$namespace/$method" : $method;
 186         my $action = $self->create_action(
 187             name       => $method,
 188             code       => $code,
 189             reverse    => $reverse,
 190             namespace  => $namespace,
 191             class      => $class,
 192             attributes => $attrs,
 193         );
 194
 195         $c->dispatcher->register( $c, $action );
 196     }
 197 }
 198
 199 sub create_action {
 200     my $self = shift;
 201     my %args = @_;
 202
 203     my $class = (exists $args{attributes}{ActionClass}
 204                     ? $args{attributes}{ActionClass}[0]
 205                     : $self->_action_class);
 206
 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);
 210     #}
 211     Class::MOP::load_class($class);
 212
 213     return $class->new( \%args );
 214 }
 215
 216 sub _parse_attrs {
 217     my ( $self, $c, $name, @attrs ) = @_;
 218
 219     my %raw_attributes;
 220
 221     foreach my $attr (@attrs) {
 222
 223         # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
 224
 225         if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
 226         {
 227
 228             if ( defined $value ) {
 229                 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
 230             }
 231             push( @{ $raw_attributes{$key} }, $value );
 232         }
 233     }
 234
 235     my $hash = (ref $self ? $self : $self->config); # hate app-is-class
 236
 237     if (exists $hash->{actions} || exists $hash->{action}) {
 238       my $a = $hash->{actions} || $hash->{action};
 239       %raw_attributes = ((exists $a->{'*'} ? %{$a->{'*'}} : ()),
 240                          %raw_attributes,
 241                          (exists $a->{$name} ? %{$a->{$name}} : ()));
 242     }
 243
 244     my %final_attributes;
 245
 246     foreach my $key (keys %raw_attributes) {
 247
 248         my $raw = $raw_attributes{$key};
 249
 250         foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
 251
 252             my $meth = "_parse_${key}_attr";
 253             if ( $self->can($meth) ) {
 254                 ( $key, $value ) = $self->$meth( $c, $name, $value );
 255             }
 256             push( @{ $final_attributes{$key} }, $value );
 257         }
 258     }
 259
 260     return \%final_attributes;
 261 }
 262
 263 sub _parse_Global_attr {
 264     my ( $self, $c, $name, $value ) = @_;
 265     return $self->_parse_Path_attr( $c, $name, "/$name" );
 266 }
 267
 268 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
 269
 270 sub _parse_Local_attr {
 271     my ( $self, $c, $name, $value ) = @_;
 272     return $self->_parse_Path_attr( $c, $name, $name );
 273 }
 274
 275 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
 276
 277 sub _parse_Path_attr {
 278     my ( $self, $c, $name, $value ) = @_;
 279     $value ||= '';
 280     if ( $value =~ m!^/! ) {
 281         return ( 'Path', $value );
 282     }
 283     elsif ( length $value ) {
 284         return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
 285     }
 286     else {
 287         return ( 'Path', $self->path_prefix($c) );
 288     }
 289 }
 290
 291 sub _parse_Regex_attr {
 292     my ( $self, $c, $name, $value ) = @_;
 293     return ( 'Regex', $value );
 294 }
 295
 296 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
 297
 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}" );
 302 }
 303
 304 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
 305
 306 sub _parse_ActionClass_attr {
 307     my ( $self, $c, $name, $value ) = @_;
 308     unless ( $value =~ s/^\+// ) {
 309       $value = join('::', $self->_action_class, $value );
 310     }
 311     return ( 'ActionClass', $value );
 312 }
 313
 314 sub _parse_MyAction_attr {
 315     my ( $self, $c, $name, $value ) = @_;
 316
 317     my $appclass = Catalyst::Utils::class2appclass($self);
 318     $value = "${appclass}::Action::${value}";
 319
 320     return ( 'ActionClass', $value );
 321 }
 322
 323 1;
 324
 325 __END__
 326
 327 =head1 CONFIGURATION
 328
 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:
 332
 333 =head2 namespace
 334
 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).
 340
 341 =head2 path
 342
 343 Sets 'path_prefix', as described below.
 344
 345 =head1 METHODS
 346
 347 =head2 $class->new($app, @args)
 348
 349 Proxies through to NEXT::new and stashes the application instance as
 350 $self->_application.
 351
 352 =head2 $self->action_for('name')
 353
 354 Returns the Catalyst::Action object (if any) for a given method name
 355 in this component.
 356
 357 =head2 $self->register_actions($c)
 358
 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.
 362
 363 =head2 $self->action_namespace($c)
 364
 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.
 369
 370
 371 =head2 $self->path_prefix($c)
 372
 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.
 376
 377 =head2 $self->create_action(%args)
 378
 379 Called with a hash of data to be use for construction of a new
 380 Catalyst::Action (or appropriate sub/alternative class) object.
 381
 382 Primarily designed for the use of register_actions.
 383
 384 =head2 $self->_application
 385
 386 =head2 $self->_app
 387
 388 Returns the application instance stored by C<new()>
 389
 390 =head1 AUTHOR
 391
 392 Sebastian Riedel, C<sri@oook.de>
 393 Marcus Ramberg C<mramberg@cpan.org>
 394
 395 =head1 COPYRIGHT
 396
 397 This program is free software, you can redistribute it and/or modify
 398 it under the same terms as Perl itself.
 399
 400 =cut