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 { {} });
37 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
109 my ( $self, $c ) = @_;
110 if ( my $action = $c->action ) {
111 $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
115 my $path = $c->req->path;
117 ? qq/Unknown resource "$path"/
118 : "No default action defined";
119 $c->log->error($error) if $c->debug;
124 # $self->_command2action( $c, $command [, \@arguments ] )
125 # Search for an action, from the command and returns C<($action, $args)> 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;
138 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
139 @args = @{ pop @extra_params }
141 # this is a copy, it may take some abuse from
142 # ->_invoke_as_path if the path had trailing parts
143 @args = @{ $c->request->arguments };
148 # go to a string path ("/foo/bar/gorch")
150 if (Scalar::Util::blessed($command) && $command->isa('Catalyst::Action')) {
154 $action = $self->_invoke_as_path( $c, "$command", \@args );
157 # go to a component ( "MyApp::*::Foo" or $c->component("...")
158 # - a path or an object)
160 my $method = @extra_params ? $extra_params[0] : "process";
161 $action = $self->_invoke_as_component( $c, $command, $method );
164 return $action, \@args;
167 =head2 $self->visit( $c, $command [, \@arguments ] )
169 Documented in L<Catalyst>
175 $self->_do_visit('visit', @_);
181 my ( $c, $command ) = @_;
182 my ( $action, $args ) = $self->_command2action(@_);
183 my $error = qq/Couldn't $opname("$command"): /;
186 $error .= qq/Couldn't $opname to command "$command": /
187 .qq/Invalid action or component./;
189 elsif (!defined $action->namespace) {
190 $error .= qq/Action has no namespace: cannot $opname() to a plain /
191 .qq/method or component, must be a :Action or some sort./
193 elsif (!$action->class->can('_DISPATCH')) {
194 $error .= qq/Action cannot _DISPATCH. /
195 .qq/Did you try to $opname() a non-controller action?/;
203 $c->log->debug($error) if $c->debug;
207 $action = $self->expand_action($action);
209 local $c->request->{arguments} = $args;
210 local $c->{namespace} = $action->{'namespace'};
211 local $c->{action} = $action;
216 =head2 $self->go( $c, $command [, \@arguments ] )
218 Documented in L<Catalyst>
224 $self->_do_visit('go', @_);
228 =head2 $self->forward( $c, $command [, \@arguments ] )
230 Documented in L<Catalyst>
236 $self->_do_forward(forward => @_);
242 my ( $c, $command ) = @_;
243 my ( $action, $args ) = $self->_command2action(@_);
246 my $error .= qq/Couldn't $opname to command "$command": /
247 .qq/Invalid action or component./;
249 $c->log->debug($error) if $c->debug;
253 no warnings 'recursion';
255 local $c->request->{arguments} = $args;
256 $action->dispatch( $c );
261 =head2 $self->detach( $c, $command [, \@arguments ] )
263 Documented in L<Catalyst>
268 my ( $self, $c, $command, @args ) = @_;
269 $self->_do_forward(detach => $c, $command, @args ) if $command;
270 die $Catalyst::DETACH;
273 sub _action_rel2abs {
274 my ( $self, $c, $path ) = @_;
276 unless ( $path =~ m#^/# ) {
277 my $namespace = $c->stack->[-1]->namespace;
278 $path = "$namespace/$path";
285 sub _invoke_as_path {
286 my ( $self, $c, $rel_path, $args ) = @_;
288 my $path = $self->_action_rel2abs( $c, $rel_path );
290 my ( $tail, @extra_args );
291 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
292 { # allow $path to be empty
293 if ( my $action = $c->get_action( $tail, $path ) ) {
294 push @$args, @extra_args;
300 ; # if a match on the global namespace failed then the whole lookup failed
303 unshift @extra_args, $tail;
307 sub _find_component_class {
308 my ( $self, $c, $component ) = @_;
310 return ref($component)
311 || ref( $c->component($component) )
312 || $c->component($component);
315 sub _invoke_as_component {
316 my ( $self, $c, $component, $method ) = @_;
318 my $class = $self->_find_component_class( $c, $component ) || return 0;
320 if ( my $code = $class->can($method) ) {
321 return $self->_method_action_class->new(
325 reverse => "$class->$method",
327 namespace => Catalyst::Utils::class2prefix(
328 $class, $c->config->{case_sensitive}
335 qq/Couldn't forward to "$class". Does not implement "$method"/;
337 $c->log->debug($error)
343 =head2 $self->prepare_action($c)
345 Find an dispatch type that matches $c->req->path, and set args from it.
350 my ( $self, $c ) = @_;
352 my $path = $req->path;
353 my @path = split /\//, $req->path;
354 $req->args( \my @args );
356 unshift( @path, '' ); # Root action
358 DESCEND: while (@path) {
359 $path = join '/', @path;
362 $path = '' if $path eq '/'; # Root action
364 # Check out dispatch types to see if any will handle the path at
367 foreach my $type ( @{ $self->_dispatch_types } ) {
368 last DESCEND if $type->match( $c, $path );
371 # If not, move the last part path to args
372 my $arg = pop(@path);
373 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
377 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
379 $c->log->debug( 'Path is "' . $req->match . '"' )
380 if ( $c->debug && defined $req->match && length $req->match );
382 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
383 if ( $c->debug && @args );
386 =head2 $self->get_action( $action, $namespace )
388 returns a named action from a given namespace.
393 my ( $self, $name, $namespace ) = @_;
396 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
398 return $self->_action_hash->{"${namespace}/${name}"};
401 =head2 $self->get_action_by_path( $path );
403 Returns the named action by its full path.
407 sub get_action_by_path {
408 my ( $self, $path ) = @_;
410 $path = "/$path" unless $path =~ /\//;
411 $self->_action_hash->{$path};
414 =head2 $self->get_actions( $c, $action, $namespace )
419 my ( $self, $c, $action, $namespace ) = @_;
420 return [] unless $action;
422 $namespace = join( "/", grep { length } split '/', $namespace || "" );
424 my @match = $self->get_containers($namespace);
426 return map { $_->get_action($action) } @match;
429 =head2 $self->get_containers( $namespace )
431 Return all the action containers for a given namespace, inclusive
436 my ( $self, $namespace ) = @_;
438 $namespace = '' if $namespace eq '/';
442 if ( length $namespace ) {
444 push @containers, $self->_container_hash->{$namespace};
445 } while ( $namespace =~ s#/[^/]+$## );
448 return reverse grep { defined } @containers, $self->_container_hash->{''};
450 #return (split '/', $namespace); # isnt this more clear?
451 my @parts = split '/', $namespace;
454 =head2 $self->uri_for_action($action, \@captures)
456 Takes a Catalyst::Action object and action parameters and returns a URI
457 part such that if $c->req->path were this URI part, this action would be
458 dispatched to with $c->req->captures set to the supplied arrayref.
460 If the action object is not available for external dispatch or the dispatcher
461 cannot determine an appropriate URI, this method will return undef.
466 my ( $self, $action, $captures) = @_;
468 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
469 my $uri = $dispatch_type->uri_for_action( $action, $captures );
470 return( $uri eq '' ? '/' : $uri )
478 expand an action into a full representation of the dispatch.
479 mostly useful for chained, other actions will just return a
485 my ($self, $action) = @_;
487 foreach my $dispatch_type (@{ $self->_dispatch_types }) {
488 my $expanded = $dispatch_type->expand_action($action);
489 return $expanded if $expanded;
495 =head2 $self->register( $c, $action )
497 Make sure all required dispatch types for this action are loaded, then
498 pass the action to our dispatch types so they can register it if required.
499 Also, set up the tree with the action containers.
504 my ( $self, $c, $action ) = @_;
506 my $registered = $self->_registered_dispatch_types;
508 #my $priv = 0; #seems to be unused
509 foreach my $key ( keys %{ $action->attributes } ) {
510 next if $key eq 'Private';
511 my $class = "Catalyst::DispatchType::$key";
512 unless ( $registered->{$class} ) {
513 # FIXME - Some error checking and re-throwing needed here, as
514 # we eat exceptions loading dispatch types.
515 eval { Class::MOP::load_class($class) };
516 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
517 $registered->{$class} = 1;
521 # Pass the action to our dispatch types so they can register it if reqd.
522 foreach my $type ( @{ $self->_dispatch_types } ) {
523 $type->register( $c, $action );
526 my $namespace = $action->namespace;
527 my $name = $action->name;
529 my $container = $self->_find_or_create_action_container($namespace);
531 # Set the method value
532 $container->add_action($action);
534 $self->_action_hash->{"$namespace/$name"} = $action;
535 $self->_container_hash->{$namespace} = $container;
538 sub _find_or_create_action_container {
539 my ( $self, $namespace ) = @_;
541 my $tree ||= $self->_tree;
543 return $tree->getNodeValue unless $namespace;
545 my @namespace = split '/', $namespace;
546 return $self->_find_or_create_namespace_node( $tree, @namespace )
550 sub _find_or_create_namespace_node {
551 my ( $self, $parent, $part, @namespace ) = @_;
553 return $parent unless $part;
556 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
559 my $container = Catalyst::ActionContainer->new($part);
560 $parent->addChild( $child = Tree::Simple->new($container) );
563 $self->_find_or_create_namespace_node( $child, @namespace );
566 =head2 $self->setup_actions( $class, $context )
572 my ( $self, $c ) = @_;
576 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
577 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
579 foreach my $comp ( values %{ $c->components } ) {
580 $comp->register_actions($c) if $comp->can('register_actions');
583 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
585 return unless $c->debug;
587 my $column_width = Catalyst::Utils::term_width() - 20 - 36 - 12;
588 my $privates = Text::SimpleTable->new(
589 [ 20, 'Private' ], [ 36, 'Class' ], [ $column_width, 'Method' ]
594 my ( $walker, $parent, $prefix ) = @_;
595 $prefix .= $parent->getNodeValue || '';
596 $prefix .= '/' unless $prefix =~ /\/$/;
597 my $node = $parent->getNodeValue->actions;
599 for my $action ( keys %{$node} ) {
600 my $action_obj = $node->{$action};
602 if ( ( $action =~ /^_.*/ )
603 && ( !$c->config->{show_internal_actions} ) );
604 $privates->row( "$prefix$action", $action_obj->class, $action );
608 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
611 $walker->( $walker, $self->_tree, '' );
612 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
615 # List all public actions
616 $_->list($c) for @{ $self->_dispatch_types };
619 sub _load_dispatch_types {
620 my ( $self, @types ) = @_;
624 # Preload action types
625 for my $type (@types) {
627 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
629 eval { Class::MOP::load_class($class) };
630 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
632 push @{ $self->_dispatch_types }, $class->new;
634 push @loaded, $class;
642 # 5.70 backwards compatibility hacks.
644 # Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL)
645 # need the methods here which *should* be private..
647 # However we can't really take them away until there is a sane API for
648 # building actions and configuring / introspecting the dispatcher.
649 # In 5.90, we should build that infrastructure, port the plugins which
650 # use it, and then take the crap below away.
651 # See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
653 # Alias _method_name to method_name, add a before modifier to warn..
654 foreach my $public_method_name (qw/
657 registered_dispatch_types
662 my $private_method_name = '_' . $public_method_name;
663 my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time.
664 $meta->add_method($public_method_name, $meta->get_method($private_method_name));
666 my %package_hash; # Only warn once per method, per package. These are infrequent enough that
667 # I haven't provided a way to disable them, patches welcome.
668 $meta->add_before_method_modifier($public_method_name, sub {
669 my $class = Scalar::Util::blessed(shift);
670 $package_hash{$class}++ || do {
671 warn("Class $class is calling the deprecated method Catalyst::Dispatcher::$public_method_name,\n"
672 . "this will be removed in Catalyst 5.9X");
677 # End 5.70 backwards compatibility hacks.
680 __PACKAGE__->meta->make_immutable;
688 Catalyst Contributors, see Catalyst.pm
692 This program is free software, you can redistribute it and/or modify it under
693 the same terms as Perl itself.