1 package Catalyst::Dispatcher;
5 use Catalyst::Exception;
8 use Catalyst::ActionContainer;
9 use Catalyst::DispatchType::Default;
10 use Catalyst::DispatchType::Index;
11 use Text::SimpleTable;
13 use Tree::Simple::Visitor::FindByPath;
17 use overload '""' => sub { return ref shift }, fallback => 1;
20 # Preload these action types
21 our @PRELOAD = qw/Index Path Regex/;
23 # Postload these action types
24 our @POSTLOAD = qw/Default/;
26 has _tree => (is => 'rw');
27 has _dispatch_types => (is => 'rw');
28 has _registered_dispatch_types => (is => 'rw');
29 has _method_action_class => (is => 'rw');
30 has _action_container_class => (is => 'rw');
31 has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
32 has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
33 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
34 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
40 Catalyst::Dispatcher - The Catalyst Dispatcher
48 This is the class that maps public urls to actions in your Catalyst
49 application based on the attributes you set.
55 Construct a new dispatcher.
60 my ($self, $params) = @_;
63 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
65 $self->_tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
68 =head2 $self->preload_dispatch_types
70 An arrayref of pre-loaded dispatchtype classes
72 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
73 To use a custom class outside the regular C<Catalyst> namespace, prefix
74 it with a C<+>, like so:
78 =head2 $self->postload_dispatch_types
80 An arrayref of post-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->detach( $c, $command [, \@arguments ] )
90 Documented in L<Catalyst>
95 my ( $self, $c, $command, @args ) = @_;
96 $c->forward( $command, @args ) if $command;
97 die $Catalyst::DETACH;
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 ) = @_;
111 $c->forward( join( '/', '', $c->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 =head2 $self->forward( $c, $command [, \@arguments ] )
126 Documented in L<Catalyst>
131 my ( $self, $c, $command, @extra_params ) = @_;
134 $c->log->debug('Nothing to forward to') if $c->debug;
140 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
141 @args = @{ pop @extra_params }
143 # this is a copy, it may take some abuse from ->_invoke_as_path if the path had trailing parts
144 @args = @{ $c->request->arguments };
149 # forward to a string path ("/foo/bar/gorch") or action object which stringifies to that
150 $action = $self->_invoke_as_path( $c, "$command", \@args );
152 # forward to a component ( "MyApp::*::Foo" or $c->component("...") - a path or an object)
154 my $method = @extra_params ? $extra_params[0] : "process";
155 $action = $self->_invoke_as_component( $c, $command, $method );
161 qq/Couldn't forward to command "$command": /
162 . qq/Invalid action or component./;
164 $c->log->debug($error) if $c->debug;
170 no warnings 'recursion';
172 local $c->request->{arguments} = \@args;
173 $action->dispatch( $c );
178 sub _action_rel2abs {
179 my ( $self, $c, $path ) = @_;
181 unless ( $path =~ m#^/# ) {
182 my $namespace = $c->stack->[-1]->namespace;
183 $path = "$namespace/$path";
190 sub _invoke_as_path {
191 my ( $self, $c, $rel_path, $args ) = @_;
193 my $path = $self->_action_rel2abs( $c, $rel_path );
195 my ( $tail, @extra_args );
196 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
197 { # allow $path to be empty
198 if ( my $action = $c->get_action( $tail, $path ) ) {
199 push @$args, @extra_args;
205 ; # if a match on the global namespace failed then the whole lookup failed
208 unshift @extra_args, $tail;
212 sub _find_component_class {
213 my ( $self, $c, $component ) = @_;
215 return ref($component)
216 || ref( $c->component($component) )
217 || $c->component($component);
220 sub _invoke_as_component {
221 my ( $self, $c, $component, $method ) = @_;
223 my $class = $self->_find_component_class( $c, $component ) || return 0;
225 if ( my $code = $class->can($method) ) {
226 return $self->_method_action_class->new(
230 reverse => "$class->$method",
232 namespace => Catalyst::Utils::class2prefix(
233 $class, $c->config->{case_sensitive}
240 qq/Couldn't forward to "$class". Does not implement "$method"/;
242 $c->log->debug($error)
248 =head2 $self->prepare_action($c)
250 Find an dispatch type that matches $c->req->path, and set args from it.
255 my ( $self, $c ) = @_;
256 my $path = $c->req->path;
257 my @path = split /\//, $c->req->path;
258 $c->req->args( \my @args );
260 unshift( @path, '' ); # Root action
262 DESCEND: while (@path) {
263 $path = join '/', @path;
266 $path = '' if $path eq '/'; # Root action
268 # Check out dispatch types to see if any will handle the path at
271 foreach my $type ( @{ $self->_dispatch_types } ) {
272 last DESCEND if $type->match( $c, $path );
275 # If not, move the last part path to args
276 my $arg = pop(@path);
277 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
281 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$c->req->captures||[]};
283 $c->log->debug( 'Path is "' . $c->req->match . '"' )
284 if ( $c->debug && $c->req->match );
286 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
287 if ( $c->debug && @args );
290 =head2 $self->get_action( $action, $namespace )
292 returns a named action from a given namespace.
297 my ( $self, $name, $namespace ) = @_;
300 $namespace = join( "/", grep { length } split '/', $namespace || "" );
302 return $self->_action_hash->{"$namespace/$name"};
305 =head2 $self->get_action_by_path( $path );
307 Returns the named action by its full path.
311 sub get_action_by_path {
312 my ( $self, $path ) = @_;
314 $path = "/$path" unless $path =~ /\//;
315 $self->_action_hash->{$path};
318 =head2 $self->get_actions( $c, $action, $namespace )
323 my ( $self, $c, $action, $namespace ) = @_;
324 return [] unless $action;
326 $namespace = join( "/", grep { length } split '/', $namespace || "" );
328 my @match = $self->get_containers($namespace);
330 return map { $_->get_action($action) } @match;
333 =head2 $self->get_containers( $namespace )
335 Return all the action containers for a given namespace, inclusive
340 my ( $self, $namespace ) = @_;
342 $namespace = '' if $namespace eq '/';
346 if ( length $namespace ) {
348 push @containers, $self->_container_hash->{$namespace};
349 } while ( $namespace =~ s#/[^/]+$## );
352 return reverse grep { defined } @containers, $self->_container_hash->{''};
354 my @parts = split '/', $namespace;
357 =head2 $self->uri_for_action($action, \@captures)
359 Takes a Catalyst::Action object and action parameters and returns a URI
360 part such that if $c->req->path were this URI part, this action would be
361 dispatched to with $c->req->captures set to the supplied arrayref.
363 If the action object is not available for external dispatch or the dispatcher
364 cannot determine an appropriate URI, this method will return undef.
369 my ( $self, $action, $captures) = @_;
371 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
372 my $uri = $dispatch_type->uri_for_action( $action, $captures );
373 return( $uri eq '' ? '/' : $uri )
379 =head2 $self->register( $c, $action )
381 Make sure all required dispatch types for this action are loaded, then
382 pass the action to our dispatch types so they can register it if required.
383 Also, set up the tree with the action containers.
388 my ( $self, $c, $action ) = @_;
390 my $registered = $self->_registered_dispatch_types;
393 foreach my $key ( keys %{ $action->attributes } ) {
394 next if $key eq 'Private';
395 my $class = "Catalyst::DispatchType::$key";
396 unless ( $registered->{$class} ) {
397 eval "require $class";
398 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
399 $registered->{$class} = 1;
403 # Pass the action to our dispatch types so they can register it if reqd.
404 foreach my $type ( @{ $self->_dispatch_types } ) {
405 $type->register( $c, $action );
408 my $namespace = $action->namespace;
409 my $name = $action->name;
411 my $container = $self->_find_or_create_action_container($namespace);
413 # Set the method value
414 $container->add_action($action);
416 $self->_action_hash->{"$namespace/$name"} = $action;
417 $self->_container_hash->{$namespace} = $container;
420 sub _find_or_create_action_container {
421 my ( $self, $namespace ) = @_;
423 my $tree ||= $self->_tree;
425 return $tree->getNodeValue unless $namespace;
427 my @namespace = split '/', $namespace;
428 return $self->_find_or_create_namespace_node( $tree, @namespace )
432 sub _find_or_create_namespace_node {
433 my ( $self, $parent, $part, @namespace ) = @_;
435 return $parent unless $part;
438 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
441 my $container = Catalyst::ActionContainer->new($part);
442 $parent->addChild( $child = Tree::Simple->new($container) );
445 $self->_find_or_create_namespace_node( $child, @namespace );
448 =head2 $self->setup_actions( $class, $context )
454 my ( $self, $c ) = @_;
456 $self->_dispatch_types( [] );
457 $self->_registered_dispatch_types( {} );
458 $self->_method_action_class('Catalyst::Action');
459 $self->_action_container_class('Catalyst::ActionContainer');
462 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
463 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
465 foreach my $comp ( values %{ $c->components } ) {
466 $comp->register_actions($c) if $comp->can('register_actions');
469 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
471 return unless $c->debug;
473 my $privates = Text::SimpleTable->new(
481 my ( $walker, $parent, $prefix ) = @_;
482 $prefix .= $parent->getNodeValue || '';
483 $prefix .= '/' unless $prefix =~ /\/$/;
484 my $node = $parent->getNodeValue->actions;
486 for my $action ( keys %{$node} ) {
487 my $action_obj = $node->{$action};
489 if ( ( $action =~ /^_.*/ )
490 && ( !$c->config->{show_internal_actions} ) );
491 $privates->row( "$prefix$action", $action_obj->class, $action );
495 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
498 $walker->( $walker, $self->_tree, '' );
499 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
502 # List all public actions
503 $_->list($c) for @{ $self->_dispatch_types };
506 sub _load_dispatch_types {
507 my ( $self, @types ) = @_;
511 # Preload action types
512 for my $type (@types) {
514 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
515 eval "require $class";
516 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
518 push @{ $self->_dispatch_types }, $class->new;
520 push @loaded, $class;
532 Sebastian Riedel, C<sri@cpan.org>
533 Matt S Trout, C<mst@shadowcatsystems.co.uk>
537 This program is free software, you can redistribute it and/or modify it under
538 the same terms as Perl itself.