1 package Catalyst::Dispatcher;
5 with 'MooseX::Emulate::Class::Accessor::Fast';
7 use Catalyst::Exception;
10 use Catalyst::ActionContainer;
11 use Catalyst::DispatchType::Default;
12 use Catalyst::DispatchType::Index;
14 use Text::SimpleTable;
16 use Tree::Simple::Visitor::FindByPath;
20 # do these belong as package vars or should we build these via a builder method?
21 # See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
23 # Preload these action types
24 our @PRELOAD = qw/Index Path Regex/;
26 # Postload these action types
27 our @POSTLOAD = qw/Default/;
29 # Note - see back-compat methods at end of file.
30 has _tree => (is => 'rw');
31 has _dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
32 has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
33 has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
34 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
35 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
36 has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
38 has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
40 # Wrap accessors so you can assign a list and it will capture a list ref.
41 around qw/preload_dispatch_types postload_dispatch_types/ => sub {
44 return $self->$orig([@_]) if (scalar @_ && ref $_[0] ne 'ARRAY');
45 return $self->$orig(@_);
52 Catalyst::Dispatcher - The Catalyst Dispatcher
60 This is the class that maps public urls to actions in your Catalyst
61 application based on the attributes you set.
67 Construct a new dispatcher.
72 my ($self, $params) = @_;
75 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
77 $self->_tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
80 =head2 $self->preload_dispatch_types
82 An arrayref of pre-loaded dispatchtype classes
84 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
85 To use a custom class outside the regular C<Catalyst> namespace, prefix
86 it with a C<+>, like so:
90 =head2 $self->postload_dispatch_types
92 An arrayref of post-loaded dispatchtype classes
94 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
95 To use a custom class outside the regular C<Catalyst> namespace, prefix
96 it with a C<+>, like so:
100 =head2 $self->dispatch($c)
102 Delegate the dispatch to the action that matched the url, or return a
103 message about unknown resource
108 my ( $self, $c ) = @_;
109 if ( my $action = $c->action ) {
110 $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
113 my $path = $c->req->path;
115 ? qq/Unknown resource "$path"/
116 : "No default action defined";
117 $c->log->error($error) if $c->debug;
122 # $self->_command2action( $c, $command [, \@arguments ] )
123 # $self->_command2action( $c, $command [, \@captures, \@arguments ] )
124 # Search for an action, from the command and returns C<($action, $args, $captures)> on
125 # success. Returns C<(0)> on error.
127 sub _command2action {
128 my ( $self, $c, $command, @extra_params ) = @_;
131 $c->log->debug('Nothing to go to') if $c->debug;
135 my (@args, @captures);
137 if ( ref( $extra_params[-2] ) eq 'ARRAY' ) {
138 @captures = @{ pop @extra_params };
141 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
142 @args = @{ pop @extra_params }
144 # this is a copy, it may take some abuse from
145 # ->_invoke_as_path if the path had trailing parts
146 @args = @{ $c->request->arguments };
151 # go to a string path ("/foo/bar/gorch")
153 if (blessed($command) && $command->isa('Catalyst::Action')) {
157 $action = $self->_invoke_as_path( $c, "$command", \@args );
160 # go to a component ( "MyApp::*::Foo" or $c->component("...")
161 # - a path or an object)
163 my $method = @extra_params ? $extra_params[0] : "process";
164 $action = $self->_invoke_as_component( $c, $command, $method );
167 return $action, \@args, \@captures;
170 =head2 $self->visit( $c, $command [, \@arguments ] )
172 Documented in L<Catalyst>
178 $self->_do_visit('visit', @_);
184 my ( $c, $command ) = @_;
185 my ( $action, $args, $captures ) = $self->_command2action(@_);
186 my $error = qq/Couldn't $opname("$command"): /;
189 $error .= qq/Couldn't $opname to command "$command": /
190 .qq/Invalid action or component./;
192 elsif (!defined $action->namespace) {
193 $error .= qq/Action has no namespace: cannot $opname() to a plain /
194 .qq/method or component, must be an :Action of some sort./
196 elsif (!$action->class->can('_DISPATCH')) {
197 $error .= qq/Action cannot _DISPATCH. /
198 .qq/Did you try to $opname() a non-controller action?/;
206 $c->log->debug($error) if $c->debug;
210 $action = $self->expand_action($action);
212 local $c->request->{arguments} = $args;
213 local $c->request->{captures} = $captures;
214 local $c->{namespace} = $action->{'namespace'};
215 local $c->{action} = $action;
220 =head2 $self->go( $c, $command [, \@arguments ] )
222 Documented in L<Catalyst>
228 $self->_do_visit('go', @_);
232 =head2 $self->forward( $c, $command [, \@arguments ] )
234 Documented in L<Catalyst>
240 no warnings 'recursion';
241 $self->_do_forward(forward => @_);
247 my ( $c, $command ) = @_;
248 my ( $action, $args, $captures ) = $self->_command2action(@_);
251 my $error .= qq/Couldn't $opname to command "$command": /
252 .qq/Invalid action or component./;
254 $c->log->debug($error) if $c->debug;
259 local $c->request->{arguments} = $args;
260 no warnings 'recursion';
261 $action->dispatch( $c );
266 =head2 $self->detach( $c, $command [, \@arguments ] )
268 Documented in L<Catalyst>
273 my ( $self, $c, $command, @args ) = @_;
274 $self->_do_forward(detach => $c, $command, @args ) if $command;
275 die $Catalyst::DETACH;
278 sub _action_rel2abs {
279 my ( $self, $c, $path ) = @_;
281 unless ( $path =~ m#^/# ) {
282 my $namespace = $c->stack->[-1]->namespace;
283 $path = "$namespace/$path";
290 sub _invoke_as_path {
291 my ( $self, $c, $rel_path, $args ) = @_;
293 my $path = $self->_action_rel2abs( $c, $rel_path );
295 my ( $tail, @extra_args );
296 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
297 { # allow $path to be empty
298 if ( my $action = $c->get_action( $tail, $path ) ) {
299 push @$args, @extra_args;
305 ; # if a match on the global namespace failed then the whole lookup failed
308 unshift @extra_args, $tail;
312 sub _find_component {
313 my ( $self, $c, $component ) = @_;
315 # fugly, why doesn't ->component('MyApp') work?
316 return $c if ($component eq blessed($c));
318 return blessed($component)
320 : $c->component($component);
323 sub _invoke_as_component {
324 my ( $self, $c, $component_or_class, $method ) = @_;
326 my $component = $self->_find_component($c, $component_or_class);
327 my $component_class = blessed $component || return 0;
329 if (my $code = $component_class->can('action_for')) {
330 my $possible_action = $component->$code($method);
331 return $possible_action if $possible_action;
334 if ( my $code = $component_class->can($method) ) {
335 return $self->_method_action_class->new(
339 reverse => "$component_class->$method",
340 class => $component_class,
341 namespace => Catalyst::Utils::class2prefix(
342 $component_class, $c->config->{case_sensitive}
349 qq/Couldn't forward to "$component_class". Does not implement "$method"/;
351 $c->log->debug($error)
357 =head2 $self->prepare_action($c)
359 Find an dispatch type that matches $c->req->path, and set args from it.
364 my ( $self, $c ) = @_;
366 my $path = $req->path;
367 my @path = split /\//, $req->path;
368 $req->args( \my @args );
370 unshift( @path, '' ); # Root action
372 DESCEND: while (@path) {
373 $path = join '/', @path;
376 $path = '' if $path eq '/'; # Root action
378 # Check out dispatch types to see if any will handle the path at
381 foreach my $type ( @{ $self->_dispatch_types } ) {
382 last DESCEND if $type->match( $c, $path );
385 # If not, move the last part path to args
386 my $arg = pop(@path);
387 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
391 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
393 $c->log->debug( 'Path is "' . $req->match . '"' )
394 if ( $c->debug && defined $req->match && length $req->match );
396 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
397 if ( $c->debug && @args );
400 =head2 $self->get_action( $action, $namespace )
402 returns a named action from a given namespace.
407 my ( $self, $name, $namespace ) = @_;
410 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
412 return $self->_action_hash->{"${namespace}/${name}"};
415 =head2 $self->get_action_by_path( $path );
417 Returns the named action by its full path.
421 sub get_action_by_path {
422 my ( $self, $path ) = @_;
424 $path = "/$path" unless $path =~ /\//;
425 $self->_action_hash->{$path};
428 =head2 $self->get_actions( $c, $action, $namespace )
433 my ( $self, $c, $action, $namespace ) = @_;
434 return [] unless $action;
436 $namespace = join( "/", grep { length } split '/', $namespace || "" );
438 my @match = $self->get_containers($namespace);
440 return map { $_->get_action($action) } @match;
443 =head2 $self->get_containers( $namespace )
445 Return all the action containers for a given namespace, inclusive
450 my ( $self, $namespace ) = @_;
452 $namespace = '' if $namespace eq '/';
456 if ( length $namespace ) {
458 push @containers, $self->_container_hash->{$namespace};
459 } while ( $namespace =~ s#/[^/]+$## );
462 return reverse grep { defined } @containers, $self->_container_hash->{''};
464 #return (split '/', $namespace); # isnt this more clear?
465 my @parts = split '/', $namespace;
468 =head2 $self->uri_for_action($action, \@captures)
470 Takes a Catalyst::Action object and action parameters and returns a URI
471 part such that if $c->req->path were this URI part, this action would be
472 dispatched to with $c->req->captures set to the supplied arrayref.
474 If the action object is not available for external dispatch or the dispatcher
475 cannot determine an appropriate URI, this method will return undef.
480 my ( $self, $action, $captures) = @_;
482 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
483 my $uri = $dispatch_type->uri_for_action( $action, $captures );
484 return( $uri eq '' ? '/' : $uri )
492 expand an action into a full representation of the dispatch.
493 mostly useful for chained, other actions will just return a
499 my ($self, $action) = @_;
501 foreach my $dispatch_type (@{ $self->_dispatch_types }) {
502 my $expanded = $dispatch_type->expand_action($action);
503 return $expanded if $expanded;
509 =head2 $self->register( $c, $action )
511 Make sure all required dispatch types for this action are loaded, then
512 pass the action to our dispatch types so they can register it if required.
513 Also, set up the tree with the action containers.
518 my ( $self, $c, $action ) = @_;
520 my $registered = $self->_registered_dispatch_types;
522 #my $priv = 0; #seems to be unused
523 foreach my $key ( keys %{ $action->attributes } ) {
524 next if $key eq 'Private';
525 my $class = "Catalyst::DispatchType::$key";
526 unless ( $registered->{$class} ) {
527 # FIXME - Some error checking and re-throwing needed here, as
528 # we eat exceptions loading dispatch types.
529 eval { Class::MOP::load_class($class) };
530 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
531 $registered->{$class} = 1;
535 # Pass the action to our dispatch types so they can register it if reqd.
536 foreach my $type ( @{ $self->_dispatch_types } ) {
537 $type->register( $c, $action );
540 my $namespace = $action->namespace;
541 my $name = $action->name;
543 my $container = $self->_find_or_create_action_container($namespace);
545 # Set the method value
546 $container->add_action($action);
548 $self->_action_hash->{"$namespace/$name"} = $action;
549 $self->_container_hash->{$namespace} = $container;
552 sub _find_or_create_action_container {
553 my ( $self, $namespace ) = @_;
555 my $tree ||= $self->_tree;
557 return $tree->getNodeValue unless $namespace;
559 my @namespace = split '/', $namespace;
560 return $self->_find_or_create_namespace_node( $tree, @namespace )
564 sub _find_or_create_namespace_node {
565 my ( $self, $parent, $part, @namespace ) = @_;
567 return $parent unless $part;
570 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
573 my $container = Catalyst::ActionContainer->new($part);
574 $parent->addChild( $child = Tree::Simple->new($container) );
577 $self->_find_or_create_namespace_node( $child, @namespace );
580 =head2 $self->setup_actions( $class, $context )
582 Loads all of the preload dispatch types, registers their actions and then
583 loads all of the postload dispatch types, and iterates over the tree of
584 actions, displaying the debug information if appropriate.
589 my ( $self, $c ) = @_;
592 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
593 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
595 foreach my $comp ( values %{ $c->components } ) {
596 $comp->register_actions($c) if $comp->can('register_actions');
599 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
601 return unless $c->debug;
602 $self->_display_action_tables($c);
605 sub _display_action_tables {
608 my $column_width = Catalyst::Utils::term_width() - 20 - 36 - 12;
609 my $privates = Text::SimpleTable->new(
610 [ 20, 'Private' ], [ 36, 'Class' ], [ $column_width, 'Method' ]
615 my ( $walker, $parent, $prefix ) = @_;
616 $prefix .= $parent->getNodeValue || '';
617 $prefix .= '/' unless $prefix =~ /\/$/;
618 my $node = $parent->getNodeValue->actions;
620 for my $action ( keys %{$node} ) {
621 my $action_obj = $node->{$action};
623 if ( ( $action =~ /^_.*/ )
624 && ( !$c->config->{show_internal_actions} ) );
625 $privates->row( "$prefix$action", $action_obj->class, $action );
629 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
632 $walker->( $walker, $self->_tree, '' );
633 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
636 # List all public actions
637 $_->list($c) for @{ $self->_dispatch_types };
640 sub _load_dispatch_types {
641 my ( $self, @types ) = @_;
645 # Preload action types
646 for my $type (@types) {
648 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
650 eval { Class::MOP::load_class($class) };
651 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
653 push @{ $self->_dispatch_types }, $class->new;
655 push @loaded, $class;
661 =head2 $self->dispatch_type( $type )
663 Get the DispatchType object of the relevant type, i.e. passing C<$type> of
664 C<Chained> would return a L<Catalyst::DispatchType::Chained> object (assuming
665 of course it's being used.)
670 my ($self, $name) = @_;
672 unless ($name =~ s/^\+//) {
673 $name = "Catalyst::DispatchType::" . $name;
676 for (@{ $self->_dispatch_types }) {
677 return $_ if ref($_) eq $name;
684 # 5.70 backwards compatibility hacks.
686 # Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL)
687 # need the methods here which *should* be private..
689 # However we can't really take them away until there is a sane API for
690 # building actions and configuring / introspecting the dispatcher.
691 # In 5.90, we should build that infrastructure, port the plugins which
692 # use it, and then take the crap below away.
693 # See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
695 # Alias _method_name to method_name, add a before modifier to warn..
696 foreach my $public_method_name (qw/
699 registered_dispatch_types
704 my $private_method_name = '_' . $public_method_name;
705 my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
706 $meta->add_method($public_method_name, $meta->get_method($private_method_name));
708 my %package_hash; # Only warn once per method, per package. These are infrequent enough that
709 # I haven't provided a way to disable them, patches welcome.
710 $meta->add_before_method_modifier($public_method_name, sub {
711 my $class = blessed(shift);
712 $package_hash{$class}++ || do {
713 warn("Class $class is calling the deprecated method Catalyst::Dispatcher::$public_method_name,\n"
714 . "this will be removed in Catalyst 5.9X");
719 # End 5.70 backwards compatibility hacks.
722 __PACKAGE__->meta->make_immutable;
730 Catalyst Contributors, see Catalyst.pm
734 This program is free software, you can redistribute it and/or modify it under
735 the same terms as Perl itself.