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;
17 use Class::Load qw(load_class try_load_class);
18 use Encode 2.21 'decode_utf8';
20 use namespace::clean -except => 'meta';
23 # do these belong as package vars or should we build these via a builder method?
24 # See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
26 # Preload these action types
27 our @PRELOAD = qw/Index Path/;
29 # Postload these action types
30 our @POSTLOAD = qw/Default/;
32 # Note - see back-compat methods at end of file.
33 has _tree => (is => 'rw', builder => '_build__tree');
34 has dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
35 has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
36 has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
37 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
38 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
40 my %dispatch_types = ( pre => \@PRELOAD, post => \@POSTLOAD );
41 foreach my $type (keys %dispatch_types) {
42 has $type . "load_dispatch_types" => (
43 is => 'rw', required => 1, lazy => 1, default => sub { $dispatch_types{$type} },
44 traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'], # List assignment is CAF style
50 Catalyst::Dispatcher - The Catalyst Dispatcher
58 This is the class that maps public urls to actions in your Catalyst
59 application based on the attributes you set.
65 Construct a new dispatcher.
73 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
75 return Tree::Simple->new($container, Tree::Simple->ROOT);
78 =head2 $self->preload_dispatch_types
80 An arrayref of pre-loaded dispatchtype classes
82 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
83 To use a custom class outside the regular C<Catalyst> namespace, prefix
84 it with a C<+>, like so:
88 =head2 $self->postload_dispatch_types
90 An arrayref of post-loaded dispatchtype classes
92 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
93 To use a custom class outside the regular C<Catalyst> namespace, prefix
94 it with a C<+>, like so:
98 =head2 $self->dispatch($c)
100 Delegate the dispatch to the action that matched the url, or return a
101 message about unknown resource
106 my ( $self, $c ) = @_;
107 if ( my $action = $c->action ) {
108 $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
111 my $path = $c->req->path;
112 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
113 $path = decode_utf8($path);
116 ? qq/Unknown resource "$path"/
117 : "No default action defined";
118 $c->log->error($error) if $c->debug;
123 # $self->_command2action( $c, $command [, \@arguments ] )
124 # $self->_command2action( $c, $command [, \@captures, \@arguments ] )
125 # Search for an action, from the command and returns C<($action, $args, $captures)> on
126 # success. Returns C<(0)> on error.
128 sub _command2action {
129 my ( $self, $c, $command, @extra_params ) = @_;
132 $c->log->debug('Nothing to go to') if $c->debug;
136 my (@args, @captures);
138 if ( ref( $extra_params[-2] ) eq 'ARRAY' ) {
139 @captures = @{ splice @extra_params, -2, 1 };
142 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
143 @args = @{ pop @extra_params }
145 # this is a copy, it may take some abuse from
146 # ->_invoke_as_path if the path had trailing parts
147 @args = @{ $c->request->arguments };
152 # go to a string path ("/foo/bar/gorch")
154 if (blessed($command) && $command->isa('Catalyst::Action')) {
158 $action = $self->_invoke_as_path( $c, "$command", \@args );
161 # go to a component ( "View::Foo" or $c->component("...")
162 # - a path or an object)
164 my $method = @extra_params ? $extra_params[0] : "process";
165 $action = $self->_invoke_as_component( $c, $command, $method );
168 return $action, \@args, \@captures;
171 =head2 $self->visit( $c, $command [, \@arguments ] )
173 Documented in L<Catalyst>
179 $self->_do_visit('visit', @_);
185 my ( $c, $command ) = @_;
186 my ( $action, $args, $captures ) = $self->_command2action(@_);
187 my $error = qq/Couldn't $opname("$command"): /;
190 $error .= qq/Couldn't $opname to command "$command": /
191 .qq/Invalid action or component./;
193 elsif (!defined $action->namespace) {
194 $error .= qq/Action has no namespace: cannot $opname() to a plain /
195 .qq/method or component, must be an :Action of some sort./
197 elsif (!$action->class->can('_DISPATCH')) {
198 $error .= qq/Action cannot _DISPATCH. /
199 .qq/Did you try to $opname() a non-controller action?/;
207 $c->log->debug($error) if $c->debug;
211 $action = $self->expand_action($action);
213 local $c->request->{arguments} = $args;
214 local $c->request->{captures} = $captures;
215 local $c->{namespace} = $action->{'namespace'};
216 local $c->{action} = $action;
221 =head2 $self->go( $c, $command [, \@arguments ] )
223 Documented in L<Catalyst>
229 $self->_do_visit('go', @_);
230 Catalyst::Exception::Go->throw;
233 =head2 $self->forward( $c, $command [, \@arguments ] )
235 Documented in L<Catalyst>
241 no warnings 'recursion';
242 return $self->_do_forward(forward => @_);
248 my ( $c, $command ) = @_;
249 my ( $action, $args, $captures ) = $self->_command2action(@_);
252 my $error .= qq/Couldn't $opname to command "$command": /
253 .qq/Invalid action or component./;
255 $c->log->debug($error) if $c->debug;
260 local $c->request->{arguments} = $args;
261 no warnings 'recursion';
262 $action->dispatch( $c );
264 #If there is an error, all bets off regarding state. Documentation
265 #Specifies that when you forward, if there's an error you must expect
267 if( @{ $c->error }) {
273 =head2 $self->detach( $c, $command [, \@arguments ] )
275 Documented in L<Catalyst>
280 my ( $self, $c, $command, @args ) = @_;
281 $self->_do_forward(detach => $c, $command, @args ) if $command;
282 $c->state(0); # Needed in order to skip any auto functions
283 Catalyst::Exception::Detach->throw;
286 sub _action_rel2abs {
287 my ( $self, $c, $path ) = @_;
289 unless ( $path =~ m#^/# ) {
290 my $namespace = $c->stack->[-1]->namespace;
291 $path = "$namespace/$path";
298 sub _invoke_as_path {
299 my ( $self, $c, $rel_path, $args ) = @_;
301 my $path = $self->_action_rel2abs( $c, $rel_path );
303 my ( $tail, @extra_args );
304 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
305 { # allow $path to be empty
306 if ( my $action = $c->get_action( $tail, $path ) ) {
307 push @$args, @extra_args;
313 ; # if a match on the global namespace failed then the whole lookup failed
316 unshift @extra_args, $tail;
320 sub _find_component {
321 my ( $self, $c, $component ) = @_;
323 # fugly, why doesn't ->component('MyApp') work?
324 return $c if ($component eq blessed($c));
326 return blessed($component)
328 : $c->component($component);
331 sub _invoke_as_component {
332 my ( $self, $c, $component_or_class, $method ) = @_;
334 my $component = $self->_find_component($c, $component_or_class);
335 my $component_class = blessed $component || return 0;
337 if (my $code = $component_class->can('action_for')) {
338 my $possible_action = $component->$code($method);
339 return $possible_action if $possible_action;
342 if ( my $code = $component_class->can($method) ) {
343 return $self->_method_action_class->new(
347 reverse => "$component_class->$method",
348 class => $component_class,
349 namespace => Catalyst::Utils::class2prefix(
350 $component_class, ref($c)->config->{case_sensitive}
357 qq/Couldn't forward to "$component_class". Does not implement "$method"/;
359 $c->log->debug($error)
365 =head2 $self->prepare_action($c)
367 Find an dispatch type that matches $c->req->path, and set args from it.
372 my ( $self, $c ) = @_;
374 my $path = $req->path;
375 my @path = split /\//, $req->path;
376 $req->args( \my @args );
378 unshift( @path, '' ); # Root action
380 DESCEND: while (@path) {
381 $path = join '/', @path;
384 # Check out dispatch types to see if any will handle the path at
387 foreach my $type ( @{ $self->dispatch_types } ) {
388 last DESCEND if $type->match( $c, $path );
391 # If not, move the last part path to args
392 my $arg = pop(@path);
393 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
397 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
399 if($c->debug && defined $req->match && length $req->match) {
400 my $match = $req->match;
401 $match =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
402 $match = decode_utf8($match);
403 $c->log->debug( 'Path is "' . $match . '"' )
406 $c->log->debug( 'Arguments are "' . join( '/', map { decode_utf8 $_ } @args ) . '"' )
407 if ( $c->debug && @args );
410 =head2 $self->get_action( $action, $namespace )
412 returns a named action from a given namespace.
417 my ( $self, $name, $namespace ) = @_;
420 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
422 return $self->_action_hash->{"${namespace}/${name}"};
425 =head2 $self->get_action_by_path( $path );
427 Returns the named action by its full private path.
431 sub get_action_by_path {
432 my ( $self, $path ) = @_;
434 $path = "/$path" unless $path =~ /\//;
435 $self->_action_hash->{$path};
438 =head2 $self->get_actions( $c, $action, $namespace )
443 my ( $self, $c, $action, $namespace ) = @_;
444 return [] unless $action;
446 $namespace = join( "/", grep { length } split '/', $namespace || "" );
448 my @match = $self->get_containers($namespace);
450 return map { $_->get_action($action) } @match;
453 =head2 $self->get_containers( $namespace )
455 Return all the action containers for a given namespace, inclusive
460 my ( $self, $namespace ) = @_;
462 $namespace = '' if $namespace eq '/';
466 if ( length $namespace ) {
468 push @containers, $self->_container_hash->{$namespace};
469 } while ( $namespace =~ s#/[^/]+$## );
472 return reverse grep { defined } @containers, $self->_container_hash->{''};
475 =head2 $self->uri_for_action($action, \@captures)
477 Takes a Catalyst::Action object and action parameters and returns a URI
478 part such that if $c->req->path were this URI part, this action would be
479 dispatched to with $c->req->captures set to the supplied arrayref.
481 If the action object is not available for external dispatch or the dispatcher
482 cannot determine an appropriate URI, this method will return undef.
487 my ( $self, $action, $captures) = @_;
489 foreach my $dispatch_type ( @{ $self->dispatch_types } ) {
490 my $uri = $dispatch_type->uri_for_action( $action, $captures );
491 return( $uri eq '' ? '/' : $uri )
499 expand an action into a full representation of the dispatch.
500 mostly useful for chained, other actions will just return a
506 my ($self, $action) = @_;
508 foreach my $dispatch_type (@{ $self->dispatch_types }) {
509 my $expanded = $dispatch_type->expand_action($action);
510 return $expanded if $expanded;
516 =head2 $self->register( $c, $action )
518 Make sure all required dispatch types for this action are loaded, then
519 pass the action to our dispatch types so they can register it if required.
520 Also, set up the tree with the action containers.
525 my ( $self, $c, $action ) = @_;
527 my $registered = $self->_registered_dispatch_types;
529 foreach my $key ( keys %{ $action->attributes } ) {
530 next if $key eq 'Private';
531 my $class = "Catalyst::DispatchType::$key";
532 unless ( $registered->{$class} ) {
533 # FIXME - Some error checking and re-throwing needed here, as
534 # we eat exceptions loading dispatch types.
535 # see also try_load_class
536 eval { load_class($class) };
537 my $load_failed = $@;
538 $self->_check_deprecated_dispatch_type( $key, $load_failed );
539 push( @{ $self->dispatch_types }, $class->new ) unless $load_failed;
540 $registered->{$class} = 1;
544 my @dtypes = @{ $self->dispatch_types };
546 my @low_precedence_dtypes;
548 for my $type ( @dtypes ) {
549 if ($type->_is_low_precedence) {
550 push @low_precedence_dtypes, $type;
552 push @normal_dtypes, $type;
556 # Pass the action to our dispatch types so they can register it if reqd.
557 my $was_registered = 0;
558 foreach my $type ( @normal_dtypes ) {
559 $was_registered = 1 if $type->register( $c, $action );
562 if (not $was_registered) {
563 foreach my $type ( @low_precedence_dtypes ) {
564 $type->register( $c, $action );
568 my $namespace = $action->namespace;
569 my $name = $action->name;
571 my $container = $self->_find_or_create_action_container($namespace);
573 # Set the method value
574 $container->add_action($action);
576 $self->_action_hash->{"$namespace/$name"} = $action;
577 $self->_container_hash->{$namespace} = $container;
580 sub _find_or_create_action_container {
581 my ( $self, $namespace ) = @_;
583 my $tree ||= $self->_tree;
585 return $tree->getNodeValue unless $namespace;
587 my @namespace = split '/', $namespace;
588 return $self->_find_or_create_namespace_node( $tree, @namespace )
592 sub _find_or_create_namespace_node {
593 my ( $self, $parent, $part, @namespace ) = @_;
595 return $parent unless $part;
598 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
601 my $container = Catalyst::ActionContainer->new($part);
602 $parent->addChild( $child = Tree::Simple->new($container) );
605 $self->_find_or_create_namespace_node( $child, @namespace );
608 =head2 $self->setup_actions( $class, $context )
610 Loads all of the pre-load dispatch types, registers their actions and then
611 loads all of the post-load dispatch types, and iterates over the tree of
612 actions, displaying the debug information if appropriate.
617 my ( $self, $c ) = @_;
620 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
621 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
623 foreach my $comp ( values %{ $c->components } ) {
624 $comp = $comp->() if ref($comp) eq 'CODE';
625 $comp->register_actions($c) if $comp->can('register_actions');
628 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
630 return unless $c->debug;
631 $self->_display_action_tables($c);
634 sub _display_action_tables {
637 my $avail_width = Catalyst::Utils::term_width() - 12;
638 my $col1_width = ($avail_width * .25) < 20 ? 20 : int($avail_width * .25);
639 my $col2_width = ($avail_width * .50) < 36 ? 36 : int($avail_width * .50);
640 my $col3_width = $avail_width - $col1_width - $col2_width;
641 my $privates = Text::SimpleTable->new(
642 [ $col1_width, 'Private' ], [ $col2_width, 'Class' ], [ $col3_width, 'Method' ]
647 my ( $walker, $parent, $prefix ) = @_;
648 $prefix .= $parent->getNodeValue || '';
649 $prefix .= '/' unless $prefix =~ /\/$/;
650 my $node = $parent->getNodeValue->actions;
652 for my $action ( keys %{$node} ) {
653 my $action_obj = $node->{$action};
655 if ( ( $action =~ /^_.*/ )
656 && ( !$c->config->{show_internal_actions} ) );
657 $privates->row( "$prefix$action", $action_obj->class, $action );
661 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
664 $walker->( $walker, $self->_tree, '' );
665 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
668 # List all public actions
669 $_->list($c) for @{ $self->dispatch_types };
672 sub _load_dispatch_types {
673 my ( $self, @types ) = @_;
676 # Preload action types
677 for my $type (@types) {
678 # first param is undef because we cannot get the appclass
679 my $class = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $type);
681 my ($success, $error) = try_load_class($class);
682 Catalyst::Exception->throw( message => $error ) if not $success;
683 push @{ $self->dispatch_types }, $class->new;
685 push @loaded, $class;
691 =head2 $self->dispatch_type( $type )
693 Get the DispatchType object of the relevant type, i.e. passing C<$type> of
694 C<Chained> would return a L<Catalyst::DispatchType::Chained> object (assuming
695 of course it's being used.)
700 my ($self, $name) = @_;
702 # first param is undef because we cannot get the appclass
703 $name = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $name);
705 for (@{ $self->dispatch_types }) {
706 return $_ if ref($_) eq $name;
711 sub _check_deprecated_dispatch_type {
712 my ($self, $key, $load_failed) = @_;
714 return unless $key =~ /^(Local)?Regexp?/;
716 # TODO: Should these throw an exception rather than just warning?
718 warn( "Attempt to use deprecated $key dispatch type.\n"
719 . " Use Chained methods or install the standalone\n"
720 . " Catalyst::DispatchType::Regex if necessary.\n" );
721 } elsif ( !defined $Catalyst::DispatchType::Regex::VERSION
722 || $Catalyst::DispatchType::Regex::VERSION le '5.90020' ) {
723 # We loaded the old core version of the Regex module this will break
724 warn( "The $key DispatchType has been removed from Catalyst core.\n"
725 . " An old version of the core Catalyst::DispatchType::Regex\n"
726 . " has been loaded and will likely fail. Please remove\n"
727 . " $INC{'Catalyst/DispatchType/Regex.pm'}\n"
728 . " and use Chained methods or install the standalone\n"
729 . " Catalyst::DispatchType::Regex if necessary.\n" );
735 # 5.70 backwards compatibility hacks.
737 # Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL)
738 # need the methods here which *should* be private..
740 # You should be able to use get_actions or get_containers appropriately
741 # instead of relying on these methods which expose implementation details
742 # of the dispatcher..
744 # IRC backlog included below, please come ask if this doesn't work for you.
746 # <@t0m> 5.80, the state of. There are things in the dispatcher which have
747 # been deprecated, that we yell at anyone for using, which there isn't
748 # a good alternative for yet..
749 # <@mst> er, get_actions/get_containers provides that doesn't it?
750 # <@mst> DispatchTypes are loaded on demand anyway
751 # <@t0m> I'm thinking of things like _tree which is aliased to 'tree' with
752 # warnings otherwise shit breaks.. We're issuing warnings about the
753 # correct set of things which you shouldn't be calling..
755 # <@mst> basically, I don't see there's a need for a replacement for anything
756 # <@mst> it was never a good idea to call ->tree
757 # <@mst> nothingmuch was the only one who did AFAIK
758 # <@mst> and he admitted it was a hack ;)
760 # See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
762 # Alias _method_name to method_name, add a before modifier to warn..
763 foreach my $public_method_name (qw/
765 registered_dispatch_types
770 my $private_method_name = '_' . $public_method_name;
771 my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
772 $meta->add_method($public_method_name, $meta->get_method($private_method_name));
774 my %package_hash; # Only warn once per method, per package. These are infrequent enough that
775 # I haven't provided a way to disable them, patches welcome.
776 $meta->add_before_method_modifier($public_method_name, sub {
777 my $class = caller(2);
779 $package_hash{$class}++ || do {
780 warn("Class $class is calling the deprecated method\n"
781 . " Catalyst::Dispatcher::$public_method_name,\n"
782 . " this will be removed in Catalyst 5.9\n");
787 # End 5.70 backwards compatibility hacks.
789 __PACKAGE__->meta->make_immutable;
797 Catalyst Contributors, see Catalyst.pm
801 This library is free software. You can redistribute it and/or modify it under
802 the same terms as Perl itself.