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;
19 # do these belong as package vars or should we build these via a builder method?
20 # See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
22 # Preload these action types
23 our @PRELOAD = qw/Index Path Regex/;
25 # Postload these action types
26 our @POSTLOAD = qw/Default/;
28 # Note - see back-compat methods at end of file.
29 has _tree => (is => 'rw');
30 has _dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
31 has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
32 has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
33 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
34 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
35 has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
37 has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
39 # Wrap accessors so you can assign a list and it will capture a list ref.
40 around qw/preload_dispatch_types postload_dispatch_types/ => sub {
43 return $self->$orig([@_]) if (scalar @_ && ref $_[0] ne 'ARRAY');
44 return $self->$orig(@_);
51 Catalyst::Dispatcher - The Catalyst Dispatcher
59 This is the class that maps public urls to actions in your Catalyst
60 application based on the attributes you set.
66 Construct a new dispatcher.
71 my ($self, $params) = @_;
74 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
76 $self->_tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
79 =head2 $self->preload_dispatch_types
81 An arrayref of pre-loaded dispatchtype classes
83 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
84 To use a custom class outside the regular C<Catalyst> namespace, prefix
85 it with a C<+>, like so:
89 =head2 $self->postload_dispatch_types
91 An arrayref of post-loaded dispatchtype classes
93 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
94 To use a custom class outside the regular C<Catalyst> namespace, prefix
95 it with a C<+>, like so:
99 =head2 $self->dispatch($c)
101 Delegate the dispatch to the action that matched the url, or return a
102 message about unknown resource
107 my ( $self, $c ) = @_;
108 if ( my $action = $c->action ) {
109 $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
112 my $path = $c->req->path;
114 ? qq/Unknown resource "$path"/
115 : "No default action defined";
116 $c->log->error($error) if $c->debug;
121 # $self->_command2action( $c, $command [, \@arguments ] )
122 # $self->_command2action( $c, $command [, \@captures, \@arguments ] )
123 # Search for an action, from the command and returns C<($action, $args, $captures)> on
124 # success. Returns C<(0)> on error.
126 sub _command2action {
127 my ( $self, $c, $command, @extra_params ) = @_;
130 $c->log->debug('Nothing to go to') if $c->debug;
134 my (@args, @captures);
136 if ( ref( $extra_params[-2] ) eq 'ARRAY' ) {
137 @captures = @{ pop @extra_params };
140 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
141 @args = @{ pop @extra_params }
143 # this is a copy, it may take some abuse from
144 # ->_invoke_as_path if the path had trailing parts
145 @args = @{ $c->request->arguments };
150 # go to a string path ("/foo/bar/gorch")
152 if (blessed($command) && $command->isa('Catalyst::Action')) {
156 $action = $self->_invoke_as_path( $c, "$command", \@args );
159 # go to a component ( "MyApp::*::Foo" or $c->component("...")
160 # - a path or an object)
162 my $method = @extra_params ? $extra_params[0] : "process";
163 $action = $self->_invoke_as_component( $c, $command, $method );
166 return $action, \@args, \@captures;
169 =head2 $self->visit( $c, $command [, \@arguments ] )
171 Documented in L<Catalyst>
177 $self->_do_visit('visit', @_);
183 my ( $c, $command ) = @_;
184 my ( $action, $args, $captures ) = $self->_command2action(@_);
185 my $error = qq/Couldn't $opname("$command"): /;
188 $error .= qq/Couldn't $opname to command "$command": /
189 .qq/Invalid action or component./;
191 elsif (!defined $action->namespace) {
192 $error .= qq/Action has no namespace: cannot $opname() to a plain /
193 .qq/method or component, must be an :Action of some sort./
195 elsif (!$action->class->can('_DISPATCH')) {
196 $error .= qq/Action cannot _DISPATCH. /
197 .qq/Did you try to $opname() a non-controller action?/;
205 $c->log->debug($error) if $c->debug;
209 $action = $self->expand_action($action);
211 local $c->request->{arguments} = $args;
212 local $c->request->{captures} = $captures;
213 local $c->{namespace} = $action->{'namespace'};
214 local $c->{action} = $action;
219 =head2 $self->go( $c, $command [, \@arguments ] )
221 Documented in L<Catalyst>
227 $self->_do_visit('go', @_);
231 =head2 $self->forward( $c, $command [, \@arguments ] )
233 Documented in L<Catalyst>
239 $self->_do_forward(forward => @_);
245 my ( $c, $command ) = @_;
246 my ( $action, $args, $captures ) = $self->_command2action(@_);
249 my $error .= qq/Couldn't $opname to command "$command": /
250 .qq/Invalid action or component./;
252 $c->log->debug($error) if $c->debug;
256 no warnings 'recursion';
258 local $c->request->{arguments} = $args;
259 $action->dispatch( $c );
264 =head2 $self->detach( $c, $command [, \@arguments ] )
266 Documented in L<Catalyst>
271 my ( $self, $c, $command, @args ) = @_;
272 $self->_do_forward(detach => $c, $command, @args ) if $command;
273 die $Catalyst::DETACH;
276 sub _action_rel2abs {
277 my ( $self, $c, $path ) = @_;
279 unless ( $path =~ m#^/# ) {
280 my $namespace = $c->stack->[-1]->namespace;
281 $path = "$namespace/$path";
288 sub _invoke_as_path {
289 my ( $self, $c, $rel_path, $args ) = @_;
291 my $path = $self->_action_rel2abs( $c, $rel_path );
293 my ( $tail, @extra_args );
294 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
295 { # allow $path to be empty
296 if ( my $action = $c->get_action( $tail, $path ) ) {
297 push @$args, @extra_args;
303 ; # if a match on the global namespace failed then the whole lookup failed
306 unshift @extra_args, $tail;
310 sub _find_component {
311 my ( $self, $c, $component ) = @_;
313 # fugly, why doesn't ->component('MyApp') work?
314 return $c if ($component eq blessed($c));
316 return blessed($component)
318 : $c->component($component);
321 sub _invoke_as_component {
322 my ( $self, $c, $component_or_class, $method ) = @_;
324 my $component = $self->_find_component($c, $component_or_class);
325 my $component_class = blessed $component || return 0;
327 if (my $code = $component_class->can('action_for')) {
328 my $possible_action = $component->$code($method);
329 return $possible_action if $possible_action;
332 if ( my $code = $component_class->can($method) ) {
333 return $self->_method_action_class->new(
337 reverse => "$component_class->$method",
338 class => $component_class,
339 namespace => Catalyst::Utils::class2prefix(
340 $component_class, $c->config->{case_sensitive}
347 qq/Couldn't forward to "$component_class". Does not implement "$method"/;
349 $c->log->debug($error)
355 =head2 $self->prepare_action($c)
357 Find an dispatch type that matches $c->req->path, and set args from it.
362 my ( $self, $c ) = @_;
364 my $path = $req->path;
365 my @path = split /\//, $req->path;
366 $req->args( \my @args );
368 unshift( @path, '' ); # Root action
370 DESCEND: while (@path) {
371 $path = join '/', @path;
374 $path = '' if $path eq '/'; # Root action
376 # Check out dispatch types to see if any will handle the path at
379 foreach my $type ( @{ $self->_dispatch_types } ) {
380 last DESCEND if $type->match( $c, $path );
383 # If not, move the last part path to args
384 my $arg = pop(@path);
385 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
389 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
391 $c->log->debug( 'Path is "' . $req->match . '"' )
392 if ( $c->debug && defined $req->match && length $req->match );
394 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
395 if ( $c->debug && @args );
398 =head2 $self->get_action( $action, $namespace )
400 returns a named action from a given namespace.
405 my ( $self, $name, $namespace ) = @_;
408 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
410 return $self->_action_hash->{"${namespace}/${name}"};
413 =head2 $self->get_action_by_path( $path );
415 Returns the named action by its full path.
419 sub get_action_by_path {
420 my ( $self, $path ) = @_;
422 $path = "/$path" unless $path =~ /\//;
423 $self->_action_hash->{$path};
426 =head2 $self->get_actions( $c, $action, $namespace )
431 my ( $self, $c, $action, $namespace ) = @_;
432 return [] unless $action;
434 $namespace = join( "/", grep { length } split '/', $namespace || "" );
436 my @match = $self->get_containers($namespace);
438 return map { $_->get_action($action) } @match;
441 =head2 $self->get_containers( $namespace )
443 Return all the action containers for a given namespace, inclusive
448 my ( $self, $namespace ) = @_;
450 $namespace = '' if $namespace eq '/';
454 if ( length $namespace ) {
456 push @containers, $self->_container_hash->{$namespace};
457 } while ( $namespace =~ s#/[^/]+$## );
460 return reverse grep { defined } @containers, $self->_container_hash->{''};
462 #return (split '/', $namespace); # isnt this more clear?
463 my @parts = split '/', $namespace;
466 =head2 $self->uri_for_action($action, \@captures)
468 Takes a Catalyst::Action object and action parameters and returns a URI
469 part such that if $c->req->path were this URI part, this action would be
470 dispatched to with $c->req->captures set to the supplied arrayref.
472 If the action object is not available for external dispatch or the dispatcher
473 cannot determine an appropriate URI, this method will return undef.
478 my ( $self, $action, $captures) = @_;
480 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
481 my $uri = $dispatch_type->uri_for_action( $action, $captures );
482 return( $uri eq '' ? '/' : $uri )
490 expand an action into a full representation of the dispatch.
491 mostly useful for chained, other actions will just return a
497 my ($self, $action) = @_;
499 foreach my $dispatch_type (@{ $self->_dispatch_types }) {
500 my $expanded = $dispatch_type->expand_action($action);
501 return $expanded if $expanded;
507 =head2 $self->register( $c, $action )
509 Make sure all required dispatch types for this action are loaded, then
510 pass the action to our dispatch types so they can register it if required.
511 Also, set up the tree with the action containers.
516 my ( $self, $c, $action ) = @_;
518 my $registered = $self->_registered_dispatch_types;
520 #my $priv = 0; #seems to be unused
521 foreach my $key ( keys %{ $action->attributes } ) {
522 next if $key eq 'Private';
523 my $class = "Catalyst::DispatchType::$key";
524 unless ( $registered->{$class} ) {
525 # FIXME - Some error checking and re-throwing needed here, as
526 # we eat exceptions loading dispatch types.
527 eval { Class::MOP::load_class($class) };
528 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
529 $registered->{$class} = 1;
533 # Pass the action to our dispatch types so they can register it if reqd.
534 foreach my $type ( @{ $self->_dispatch_types } ) {
535 $type->register( $c, $action );
538 my $namespace = $action->namespace;
539 my $name = $action->name;
541 my $container = $self->_find_or_create_action_container($namespace);
543 # Set the method value
544 $container->add_action($action);
546 $self->_action_hash->{"$namespace/$name"} = $action;
547 $self->_container_hash->{$namespace} = $container;
550 sub _find_or_create_action_container {
551 my ( $self, $namespace ) = @_;
553 my $tree ||= $self->_tree;
555 return $tree->getNodeValue unless $namespace;
557 my @namespace = split '/', $namespace;
558 return $self->_find_or_create_namespace_node( $tree, @namespace )
562 sub _find_or_create_namespace_node {
563 my ( $self, $parent, $part, @namespace ) = @_;
565 return $parent unless $part;
568 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
571 my $container = Catalyst::ActionContainer->new($part);
572 $parent->addChild( $child = Tree::Simple->new($container) );
575 $self->_find_or_create_namespace_node( $child, @namespace );
578 =head2 $self->setup_actions( $class, $context )
580 Loads all of the preload dispatch types, registers their actions and then
581 loads all of the postload dispatch types, and iterates over the tree of
582 actions, displaying the debug information if appropriate.
587 my ( $self, $c ) = @_;
590 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
591 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
593 foreach my $comp ( values %{ $c->components } ) {
594 $comp->register_actions($c) if $comp->can('register_actions');
597 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
599 return unless $c->debug;
600 $self->_display_action_tables($c);
603 sub _display_action_tables {
606 my $column_width = Catalyst::Utils::term_width() - 20 - 36 - 12;
607 my $privates = Text::SimpleTable->new(
608 [ 20, 'Private' ], [ 36, 'Class' ], [ $column_width, 'Method' ]
613 my ( $walker, $parent, $prefix ) = @_;
614 $prefix .= $parent->getNodeValue || '';
615 $prefix .= '/' unless $prefix =~ /\/$/;
616 my $node = $parent->getNodeValue->actions;
618 for my $action ( keys %{$node} ) {
619 my $action_obj = $node->{$action};
621 if ( ( $action =~ /^_.*/ )
622 && ( !$c->config->{show_internal_actions} ) );
623 $privates->row( "$prefix$action", $action_obj->class, $action );
627 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
630 $walker->( $walker, $self->_tree, '' );
631 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
634 # List all public actions
635 $_->list($c) for @{ $self->_dispatch_types };
638 sub _load_dispatch_types {
639 my ( $self, @types ) = @_;
643 # Preload action types
644 for my $type (@types) {
646 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
648 eval { Class::MOP::load_class($class) };
649 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
651 push @{ $self->_dispatch_types }, $class->new;
653 push @loaded, $class;
659 =head2 $self->dispatch_type( $type )
661 Get the DispatchType object of the relevant type, i.e. passing C<$type> of
662 C<Chained> would return a L<Catalyst::DispatchType::Chained> object (assuming
663 of course it's being used.)
668 my ($self, $name) = @_;
670 unless ($name =~ s/^\+//) {
671 $name = "Catalyst::DispatchType::" . $name;
674 for (@{ $self->_dispatch_types }) {
675 return $_ if ref($_) eq $name;
682 # 5.70 backwards compatibility hacks.
684 # Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL)
685 # need the methods here which *should* be private..
687 # However we can't really take them away until there is a sane API for
688 # building actions and configuring / introspecting the dispatcher.
689 # In 5.90, we should build that infrastructure, port the plugins which
690 # use it, and then take the crap below away.
691 # See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
693 # Alias _method_name to method_name, add a before modifier to warn..
694 foreach my $public_method_name (qw/
697 registered_dispatch_types
702 my $private_method_name = '_' . $public_method_name;
703 my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
704 $meta->add_method($public_method_name, $meta->get_method($private_method_name));
706 my %package_hash; # Only warn once per method, per package. These are infrequent enough that
707 # I haven't provided a way to disable them, patches welcome.
708 $meta->add_before_method_modifier($public_method_name, sub {
709 my $class = blessed(shift);
710 $package_hash{$class}++ || do {
711 warn("Class $class is calling the deprecated method Catalyst::Dispatcher::$public_method_name,\n"
712 . "this will be removed in Catalyst 5.9X");
717 # End 5.70 backwards compatibility hacks.
720 __PACKAGE__->meta->make_immutable;
728 Catalyst Contributors, see Catalyst.pm
732 This program is free software, you can redistribute it and/or modify it under
733 the same terms as Perl itself.