lib/Catalyst/Controller.pm

   1 package Catalyst::Controller;
   2
   3 use Moose;
   4 use Class::MOP;
   5 use String::RewritePrefix;
   6 use Moose::Util qw/find_meta/;
   7 use List::Util qw/first/;
   8 use List::MoreUtils qw/uniq/;
   9 use namespace::clean -except => 'meta';
  10
  11 BEGIN { extends qw/Catalyst::Component MooseX::MethodAttributes::Inheritable/; }
  12
  13 use MooseX::MethodAttributes;
  14 use Catalyst::Exception;
  15 use Catalyst::Utils;
  16
  17 with 'Catalyst::Component::ApplicationAttribute';
  18
  19 has path_prefix => (
  20     is        => 'rw',
  21     isa       => 'Str',
  22     init_arg  => 'path',
  23     predicate => 'has_path_prefix',
  24 );
  25
  26 has action_namespace => (
  27     is        => 'rw',
  28     isa       => 'Str',
  29     init_arg  => 'namespace',
  30     predicate => 'has_action_namespace',
  31 );
  32
  33 has actions => (
  34     accessor => '_controller_actions',
  35     isa      => 'HashRef',
  36     init_arg => undef,
  37 );
  38
  39 has _action_role_args => (
  40     traits     => [qw(Array)],
  41     isa        => 'ArrayRef[Str]',
  42     init_arg   => 'action_roles',
  43     default    => sub { [] },
  44     handles    => {
  45         _action_role_args => 'elements',
  46     },
  47 );
  48
  49 has _action_roles => (
  50     traits     => [qw(Array)],
  51     isa        => 'ArrayRef[RoleName]',
  52     init_arg   => undef,
  53     lazy       => 1,
  54     builder    => '_build__action_roles',
  55     handles    => {
  56         _action_roles => 'elements',
  57     },
  58 );
  59
  60 has action_args => (is => 'ro');
  61
  62 # ->config(actions => { '*' => ...
  63 has _all_actions_attributes => (
  64     is       => 'ro',
  65     isa      => 'HashRef',
  66     init_arg => undef,
  67     lazy     => 1,
  68     builder  => '_build__all_actions_attributes',
  69 );
  70
  71 sub BUILD {
  72     my ($self, $args) = @_;
  73     my $action  = delete $args->{action}  || {};
  74     my $actions = delete $args->{actions} || {};
  75     my $attr_value = $self->merge_config_hashes($actions, $action);
  76     $self->_controller_actions($attr_value);
  77
  78     # trigger lazy builder
  79     $self->_all_actions_attributes;
  80     $self->_action_roles;
  81 }
  82
  83 sub _build__action_roles {
  84     my $self = shift;
  85     my @roles = $self->_expand_role_shortname($self->_action_role_args);
  86     Class::MOP::load_class($_) for @roles;
  87     return \@roles;
  88 }
  89
  90 sub _build__all_actions_attributes {
  91     my ($self) = @_;
  92     delete $self->_controller_actions->{'*'} || {};
  93 }
  94
  95 =head1 NAME
  96
  97 Catalyst::Controller - Catalyst Controller base class
  98
  99 =head1 SYNOPSIS
 100
 101   package MyApp::Controller::Search
 102   use base qw/Catalyst::Controller/;
 103
 104   sub foo : Local {
 105     my ($self,$c,@args) = @_;
 106     ...
 107   } # Dispatches to /search/foo
 108
 109 =head1 DESCRIPTION
 110
 111 Controllers are where the actions in the Catalyst framework
 112 reside. Each action is represented by a function with an attribute to
 113 identify what kind of action it is. See the L<Catalyst::Dispatcher>
 114 for more info about how Catalyst dispatches to actions.
 115
 116 =cut
 117
 118 #I think both of these could be attributes. doesn't really seem like they need
 119 #to ble class data. i think that attributes +default would work just fine
 120 __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class _action_role_prefix/;
 121
 122 __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
 123 __PACKAGE__->_action_class('Catalyst::Action');
 124 __PACKAGE__->_action_role_prefix([ 'Catalyst::ActionRole::' ]);
 125
 126
 127 sub _DISPATCH : Private {
 128     my ( $self, $c ) = @_;
 129
 130     foreach my $disp ( @{ $self->_dispatch_steps } ) {
 131         last unless $c->forward($disp);
 132     }
 133
 134     $c->forward('_END');
 135 }
 136
 137 sub _BEGIN : Private {
 138     my ( $self, $c ) = @_;
 139     my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1];
 140     return 1 unless $begin;
 141     $begin->dispatch( $c );
 142     return !@{ $c->error };
 143 }
 144
 145 sub _AUTO : Private {
 146     my ( $self, $c ) = @_;
 147     my @auto = $c->get_actions( 'auto', $c->namespace );
 148     foreach my $auto (@auto) {
 149         $auto->dispatch( $c );
 150         return 0 unless $c->state;
 151     }
 152     return 1;
 153 }
 154
 155 sub _ACTION : Private {
 156     my ( $self, $c ) = @_;
 157     if (   ref $c->action
 158         && $c->action->can('execute')
 159         && defined $c->req->action )
 160     {
 161         $c->action->dispatch( $c );
 162     }
 163     return !@{ $c->error };
 164 }
 165
 166 sub _END : Private {
 167     my ( $self, $c ) = @_;
 168     my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1];
 169     return 1 unless $end;
 170     $end->dispatch( $c );
 171     return !@{ $c->error };
 172 }
 173
 174 sub action_for {
 175     my ( $self, $name ) = @_;
 176     my $app = ($self->isa('Catalyst') ? $self : $self->_application);
 177     return $app->dispatcher->get_action($name, $self->action_namespace);
 178 }
 179
 180 #my opinion is that this whole sub really should be a builder method, not
 181 #something that happens on every call. Anyone else disagree?? -- groditi
 182 ## -- apparently this is all just waiting for app/ctx split
 183 around action_namespace => sub {
 184     my $orig = shift;
 185     my ( $self, $c ) = @_;
 186
 187     my $class = ref($self) || $self;
 188     my $appclass = ref($c) || $c;
 189     if( ref($self) ){
 190         return $self->$orig if $self->has_action_namespace;
 191     } else {
 192         return $class->config->{namespace} if exists $class->config->{namespace};
 193     }
 194
 195     my $case_s;
 196     if( $c ){
 197         $case_s = $appclass->config->{case_sensitive};
 198     } else {
 199         if ($self->isa('Catalyst')) {
 200             $case_s = $class->config->{case_sensitive};
 201         } else {
 202             if (ref $self) {
 203                 $case_s = ref($self->_application)->config->{case_sensitive};
 204             } else {
 205                 confess("Can't figure out case_sensitive setting");
 206             }
 207         }
 208     }
 209
 210     my $namespace = Catalyst::Utils::class2prefix($self->catalyst_component_name, $case_s) || '';
 211     $self->$orig($namespace) if ref($self);
 212     return $namespace;
 213 };
 214
 215 #Once again, this is probably better written as a builder method
 216 around path_prefix => sub {
 217     my $orig = shift;
 218     my $self = shift;
 219     if( ref($self) ){
 220       return $self->$orig if $self->has_path_prefix;
 221     } else {
 222       return $self->config->{path} if exists $self->config->{path};
 223     }
 224     my $namespace = $self->action_namespace(@_);
 225     $self->$orig($namespace) if ref($self);
 226     return $namespace;
 227 };
 228
 229 sub get_action_methods {
 230     my $self = shift;
 231     my $meta = find_meta($self) || confess("No metaclass setup for $self");
 232     confess(
 233         sprintf "Metaclass %s for %s cannot support register_actions.",
 234             ref $meta, $meta->name,
 235     ) unless $meta->can('get_nearest_methods_with_attributes');
 236     my @methods = $meta->get_nearest_methods_with_attributes;
 237
 238     # actions specified via config are also action_methods
 239     push(
 240         @methods,
 241         map {
 242             $meta->find_method_by_name($_)
 243                 || confess( sprintf 'Action "%s" is not available from controller %s',
 244                             $_, ref $self )
 245         } keys %{ $self->_controller_actions }
 246     ) if ( ref $self );
 247     return uniq @methods;
 248 }
 249
 250
 251 sub register_actions {
 252     my ( $self, $c ) = @_;
 253     $self->register_action_methods( $c, $self->get_action_methods );
 254 }
 255
 256 sub register_action_methods {
 257     my ( $self, $c, @methods ) = @_;
 258     my $class = $self->catalyst_component_name;
 259     #this is still not correct for some reason.
 260     my $namespace = $self->action_namespace($c);
 261
 262     # FIXME - fugly
 263     if (!blessed($self) && $self eq $c && scalar(@methods)) {
 264         my @really_bad_methods = grep { ! /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/ } map { $_->name } @methods;
 265         if (scalar(@really_bad_methods)) {
 266             $c->log->warn("Action methods (" . join(', ', @really_bad_methods) . ") found defined in your application class, $self. This is deprecated, please move them into a Root controller.");
 267         }
 268     }
 269
 270     foreach my $method (@methods) {
 271         my $name = $method->name;
 272         # Horrible hack! All method metaclasses should have an attributes
 273         # method, core Moose bug - see r13354.
 274         my $attributes = $method->can('attributes') ? $method->attributes : [];
 275         my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
 276         if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
 277             $c->log->debug( 'Bad action definition "'
 278                   . join( ' ', @{ $attributes } )
 279                   . qq/" for "$class->$name"/ )
 280               if $c->debug;
 281             next;
 282         }
 283         my $reverse = $namespace ? "${namespace}/${name}" : $name;
 284         my $action = $self->create_action(
 285             name       => $name,
 286             code       => $method->body,
 287             reverse    => $reverse,
 288             namespace  => $namespace,
 289             class      => $class,
 290             attributes => $attrs,
 291         );
 292
 293         $c->dispatcher->register( $c, $action );
 294     }
 295 }
 296
 297 sub _apply_action_class_roles {
 298     my ($self, $class, @roles) = @_;
 299
 300     Class::MOP::load_class($_) for @roles;
 301     my $meta = Moose::Meta::Class->initialize($class)->create_anon_class(
 302         superclasses => [$class],
 303         roles        => \@roles,
 304         cache        => 1,
 305     );
 306     $meta->add_method(meta => sub { $meta });
 307
 308     return $meta->name;
 309 }
 310
 311 sub action_class {
 312     my $self = shift;
 313     my %args = @_;
 314
 315     my $class = (exists $args{attributes}{ActionClass}
 316         ? $args{attributes}{ActionClass}[0]
 317         : $self->_action_class);
 318
 319     Class::MOP::load_class($class);
 320     return $class;
 321 }
 322
 323 sub create_action {
 324     my $self = shift;
 325     my %args = @_;
 326
 327     my $class = $self->action_class(%args);
 328
 329     load_class($class);
 330     Moose->init_meta(for_class => $class)
 331         unless Class::MOP::does_metaclass_exist($class);
 332
 333     unless ($args{name} =~ /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/) {
 334        my @roles = $self->gather_action_roles(%args);
 335        $class = $self->_apply_action_class_roles($class, @roles) if @roles;
 336     }
 337
 338     my $action_args = (
 339         ref($self)
 340             ? $self->action_args
 341             : $self->config->{action_args}
 342     );
 343
 344     my %extra_args = (
 345         %{ $action_args->{'*'}           || {} },
 346         %{ $action_args->{ $args{name} } || {} },
 347     );
 348
 349     return $class->new({ %extra_args, %args });
 350 }
 351
 352 sub gather_action_roles {
 353    my ($self, %args) = @_;
 354
 355    return (
 356       (blessed $self ? $self->_action_roles : ()),
 357       @{ $args{attributes}->{Does} || [] },
 358    );
 359 }
 360
 361 sub _parse_attrs {
 362     my ( $self, $c, $name, @attrs ) = @_;
 363
 364     my %raw_attributes;
 365
 366     foreach my $attr (@attrs) {
 367
 368         # Parse out :Foo(bar) into Foo => bar etc (and arrayify)
 369
 370         if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) )
 371         {
 372
 373             if ( defined $value ) {
 374                 ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ );
 375             }
 376             push( @{ $raw_attributes{$key} }, $value );
 377         }
 378     }
 379
 380     my ($actions_config, $all_actions_config);
 381     if( ref($self) ) {
 382         $actions_config = $self->_controller_actions;
 383         # No, you're not getting actions => { '*' => ... } with actions in MyApp.
 384         $all_actions_config = $self->_all_actions_attributes;
 385     } else {
 386         my $cfg = $self->config;
 387         $actions_config = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
 388         $all_actions_config = {};
 389     }
 390
 391     %raw_attributes = (
 392         %raw_attributes,
 393         # Note we deep copy array refs here to stop crapping on config
 394         # when attributes are parsed. RT#65463
 395         exists $actions_config->{$name} ? map { ref($_) eq 'ARRAY' ? [ @$_ ] : $_ } %{ $actions_config->{$name } } : (),
 396     );
 397
 398     # Private actions with additional attributes will raise a warning and then
 399     # be ignored. Adding '*' arguments to the default _DISPATCH / etc. methods,
 400     # which are Private, will prevent those from being registered. They should
 401     # probably be turned into :Actions instead, or we might want to otherwise
 402     # disambiguate between those built-in internal actions and user-level
 403     # Private ones.
 404     %raw_attributes = (%{ $all_actions_config }, %raw_attributes)
 405         unless $raw_attributes{Private};
 406
 407     my %final_attributes;
 408
 409     foreach my $key (keys %raw_attributes) {
 410
 411         my $raw = $raw_attributes{$key};
 412
 413         foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
 414
 415             my $meth = "_parse_${key}_attr";
 416             if ( my $code = $self->can($meth) ) {
 417                 ( $key, $value ) = $self->$code( $c, $name, $value );
 418             }
 419             push( @{ $final_attributes{$key} }, $value );
 420         }
 421     }
 422
 423     return \%final_attributes;
 424 }
 425
 426 sub _parse_Global_attr {
 427     my ( $self, $c, $name, $value ) = @_;
 428     return $self->_parse_Path_attr( $c, $name, "/$name" );
 429 }
 430
 431 sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
 432
 433 sub _parse_Local_attr {
 434     my ( $self, $c, $name, $value ) = @_;
 435     return $self->_parse_Path_attr( $c, $name, $name );
 436 }
 437
 438 sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
 439
 440 sub _parse_Path_attr {
 441     my ( $self, $c, $name, $value ) = @_;
 442     $value = '' if !defined $value;
 443     if ( $value =~ m!^/! ) {
 444         return ( 'Path', $value );
 445     }
 446     elsif ( length $value ) {
 447         return ( 'Path', join( '/', $self->path_prefix($c), $value ) );
 448     }
 449     else {
 450         return ( 'Path', $self->path_prefix($c) );
 451     }
 452 }
 453
 454 sub _parse_Regex_attr {
 455     my ( $self, $c, $name, $value ) = @_;
 456     return ( 'Regex', $value );
 457 }
 458
 459 sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
 460
 461 sub _parse_LocalRegex_attr {
 462     my ( $self, $c, $name, $value ) = @_;
 463     unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
 464
 465     my $prefix = $self->path_prefix( $c );
 466     $prefix .= '/' if length( $prefix );
 467
 468     return ( 'Regex', "^${prefix}${value}" );
 469 }
 470
 471 sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
 472
 473 sub _parse_Chained_attr {
 474     my ($self, $c, $name, $value) = @_;
 475
 476     if (defined($value) && length($value)) {
 477         if ($value eq '.') {
 478             $value = '/'.$self->action_namespace($c);
 479         } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) {
 480             my @parts = split '/', $self->action_namespace($c);
 481             my @levels = split '/', $rel;
 482
 483             $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest);
 484         } elsif ($value !~ m/^\//) {
 485             my $action_ns = $self->action_namespace($c);
 486
 487             if ($action_ns) {
 488                 $value = '/'.join('/', $action_ns, $value);
 489             } else {
 490                 $value = '/'.$value; # special case namespace '' (root)
 491             }
 492         }
 493     } else {
 494         $value = '/'
 495     }
 496
 497     return Chained => $value;
 498 }
 499
 500 sub _parse_ChainedParent_attr {
 501     my ($self, $c, $name, $value) = @_;
 502     return $self->_parse_Chained_attr($c, $name, '../'.$name);
 503 }
 504
 505 sub _parse_PathPrefix_attr {
 506     my ( $self, $c ) = @_;
 507     return PathPart => $self->path_prefix($c);
 508 }
 509
 510 sub _parse_ActionClass_attr {
 511     my ( $self, $c, $name, $value ) = @_;
 512     my $appname = $self->_application;
 513     $value = Catalyst::Utils::resolve_namespace($appname . '::Action', $self->_action_class, $value);
 514     return ( 'ActionClass', $value );
 515 }
 516
 517 sub _parse_MyAction_attr {
 518     my ( $self, $c, $name, $value ) = @_;
 519
 520     my $appclass = Catalyst::Utils::class2appclass($self);
 521     $value = "${appclass}::Action::${value}";
 522
 523     return ( 'ActionClass', $value );
 524 }
 525
 526 sub _parse_Does_attr {
 527     my ($self, $app, $name, $value) = @_;
 528     return Does => $self->_expand_role_shortname($value);
 529 }
 530
 531 sub _expand_role_shortname {
 532     my ($self, @shortnames) = @_;
 533     my $app = $self->_application;
 534
 535     my $prefix = $self->can('_action_role_prefix') ? $self->_action_role_prefix : ['Catalyst::ActionRole::'];
 536     my @prefixes = (qq{${app}::ActionRole::}, @$prefix);
 537
 538     return String::RewritePrefix->rewrite(
 539         { ''  => sub {
 540             my $loaded = Class::MOP::load_first_existing_class(
 541                 map { "$_$_[0]" } @prefixes
 542             );
 543             return first { $loaded =~ /^$_/ }
 544               sort { length $b <=> length $a } @prefixes;
 545           },
 546           '~' => $prefixes[0],
 547           '+' => '' },
 548         @shortnames,
 549     );
 550 }
 551
 552 __PACKAGE__->meta->make_immutable;
 553
 554 1;
 555
 556 __END__
 557
 558 =head1 CONFIGURATION
 559
 560 Like any other L<Catalyst::Component>, controllers have a config hash,
 561 accessible through $self->config from the controller actions.  Some
 562 settings are in use by the Catalyst framework:
 563
 564 =head2 namespace
 565
 566 This specifies the internal namespace the controller should be bound
 567 to. By default the controller is bound to the URI version of the
 568 controller name. For instance controller 'MyApp::Controller::Foo::Bar'
 569 will be bound to 'foo/bar'. The default Root controller is an example
 570 of setting namespace to '' (the null string).
 571
 572 =head2 path
 573
 574 Sets 'path_prefix', as described below.
 575
 576 =head2 action
 577
 578 Allows you to set the attributes that the dispatcher creates actions out of.
 579 This allows you to do 'rails style routes', or override some of the
 580 attribute definitions of actions composed from Roles.
 581 You can set arguments globally (for all actions of the controller) and
 582 specifically (for a single action).
 583
 584     __PACKAGE__->config(
 585         action => {
 586             '*' => { Chained => 'base', Args => 0  },
 587             base => { Chained => '/', PathPart => '', CaptureArgs => 0 },
 588         },
 589      );
 590
 591 In the case above every sub in the package would be made into a Chain
 592 endpoint with a URI the same as the sub name for each sub, chained
 593 to the sub named C<base>. Ergo dispatch to C</example> would call the
 594 C<base> method, then the C<example> method.
 595
 596 =head2 action_args
 597
 598 Allows you to set constructor arguments on your actions. You can set arguments
 599 globally and specifically (as above).
 600 This is particularly useful when using C<ActionRole>s
 601 (L<Catalyst::Controller::ActionRole>) and custom C<ActionClass>es.
 602
 603     __PACKAGE__->config(
 604         action_args => {
 605             '*' => { globalarg1 => 'hello', globalarg2 => 'goodbye' },
 606             'specific_action' => { customarg => 'arg1' },
 607         },
 608      );
 609
 610 In the case above the action class associated with C<specific_action> would get
 611 passed the following arguments, in addition to the normal action constructor
 612 arguments, when it is instantiated:
 613
 614   (globalarg1 => 'hello', globalarg2 => 'goodbye', customarg => 'arg1')
 615
 616 =head1 METHODS
 617
 618 =head2 BUILDARGS ($app, @args)
 619
 620 From L<Catalyst::Component::ApplicationAttribute>, stashes the application
 621 instance as $self->_application.
 622
 623 =head2 $self->action_for('name')
 624
 625 Returns the Catalyst::Action object (if any) for a given method name
 626 in this component.
 627
 628 =head2 $self->action_namespace($c)
 629
 630 Returns the private namespace for actions in this component. Defaults
 631 to a value from the controller name (for
 632 e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be
 633 overridden from the "namespace" config key.
 634
 635
 636 =head2 $self->path_prefix($c)
 637
 638 Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
 639 relative :Path actions in this component. Defaults to the action_namespace or
 640 can be overridden from the "path" config key.
 641
 642 =head2 $self->register_actions($c)
 643
 644 Finds all applicable actions for this component, creates
 645 Catalyst::Action objects (using $self->create_action) for them and
 646 registers them with $c->dispatcher.
 647
 648 =head2 $self->get_action_methods()
 649
 650 Returns a list of L<Moose::Meta::Method> objects, doing the
 651 L<MooseX::MethodAttributes::Role::Meta::Method> role, which are the set of
 652 action methods for this package.
 653
 654 =head2 $self->register_action_methods($c, @methods)
 655
 656 Creates action objects for a set of action methods using C< create_action >,
 657 and registers them with the dispatcher.
 658
 659 =head2 $self->action_class(%args)
 660
 661 Used when a controller is creating an action to determine the correct base
 662 action class to use.
 663
 664 =head2 $self->create_action(%args)
 665
 666 Called with a hash of data to be use for construction of a new
 667 Catalyst::Action (or appropriate sub/alternative class) object.
 668
 669 =head2 $self->gather_action_roles(\%action_args)
 670
 671 Gathers the list of roles to apply to an action with the given %action_args.
 672
 673 =head2 $self->_application
 674
 675 =head2 $self->_app
 676
 677 Returns the application instance stored by C<new()>
 678
 679 =head1 AUTHORS
 680
 681 Catalyst Contributors, see Catalyst.pm
 682
 683 =head1 COPYRIGHT
 684
 685 This library is free software. You can redistribute it and/or modify
 686 it under the same terms as Perl itself.
 687
 688 =cut