1 package Catalyst::Dispatcher;
4 use base 'Class::Accessor::Fast';
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;
19 __PACKAGE__->mk_accessors(
20 qw/tree dispatch_types registered_dispatch_types
21 method_action_class action_container_class
22 preload_dispatch_types postload_dispatch_types
23 action_hash container_hash
27 # Preload these action types
28 our @PRELOAD = qw/Index Path Regex/;
30 # Postload these action types
31 our @POSTLOAD = qw/Default/;
35 Catalyst::Dispatcher - The Catalyst Dispatcher
43 This is the class that maps public urls to actions in your Catalyst
44 application based on the attributes you set.
50 Construct a new dispatcher.
56 my $class = ref($self) || $self;
58 my $obj = $class->SUPER::new(@_);
60 # set the default pre- and and postloads
61 $obj->preload_dispatch_types( \@PRELOAD );
62 $obj->postload_dispatch_types( \@POSTLOAD );
63 $obj->action_hash( {} );
64 $obj->container_hash( {} );
66 # Create the root node of the tree
68 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
69 $obj->tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
74 =head2 $self->preload_dispatch_types
76 An arrayref of pre-loaded dispatchtype classes
78 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
79 To use a custom class outside the regular C<Catalyst> namespace, prefix
80 it with a C<+>, like so:
84 =head2 $self->postload_dispatch_types
86 An arrayref of post-loaded dispatchtype classes
88 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
89 To use a custom class outside the regular C<Catalyst> namespace, prefix
90 it with a C<+>, like so:
94 =head2 $self->detach( $c, $command [, \@arguments ] )
96 Documented in L<Catalyst>
101 my ( $self, $c, $command, @args ) = @_;
102 $c->forward( $command, @args ) if $command;
103 die $Catalyst::DETACH;
106 =head2 $self->dispatch($c)
108 Delegate the dispatch to the action that matched the url, or return a
109 message about unknown resource
115 my ( $self, $c ) = @_;
117 $c->forward( join( '/', '', $c->action->namespace, '_DISPATCH' ) );
121 my $path = $c->req->path;
123 ? qq/Unknown resource "$path"/
124 : "No default action defined";
125 $c->log->error($error) if $c->debug;
130 =head2 $self->forward( $c, $command [, \@arguments ] )
132 Documented in L<Catalyst>
137 my ( $self, $c, $command, @extra_params ) = @_;
140 $c->log->debug('Nothing to forward to') if $c->debug;
146 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
147 @args = @{ pop @extra_params }
149 # this is a copy, it may take some abuse from ->_invoke_as_path if the path had trailing parts
150 @args = @{ $c->request->arguments };
155 # forward to a string path ("/foo/bar/gorch") or action object which stringifies to that
156 $action = $self->_invoke_as_path( $c, "$command", \@args );
158 # forward to a component ( "MyApp::*::Foo" or $c->component("...") - a path or an object)
160 my $method = @extra_params ? $extra_params[0] : "process";
161 $action = $self->_invoke_as_component( $c, $command, $method );
167 qq/Couldn't forward to command "$command": /
168 . qq/Invalid action or component./;
170 $c->log->debug($error) if $c->debug;
176 local $c->request->{arguments} = \@args;
177 $action->dispatch( $c );
182 sub _action_rel2abs {
183 my ( $self, $c, $path ) = @_;
185 unless ( $path =~ m#^/# ) {
186 my $namespace = $c->stack->[-1]->namespace;
187 $path = "$namespace/$path";
194 sub _invoke_as_path {
195 my ( $self, $c, $rel_path, $args ) = @_;
197 my $path = $self->_action_rel2abs( $c, $rel_path );
199 my ( $tail, @extra_args );
200 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
201 { # allow $path to be empty
202 if ( my $action = $c->get_action( $tail, $path ) ) {
203 push @$args, @extra_args;
209 ; # if a match on the global namespace failed then the whole lookup failed
212 unshift @extra_args, $tail;
216 sub _find_component_class {
217 my ( $self, $c, $component ) = @_;
219 return ref($component)
220 || ref( $c->component($component) )
221 || $c->component($component);
224 sub _invoke_as_component {
225 my ( $self, $c, $component, $method ) = @_;
227 my $class = $self->_find_component_class( $c, $component ) || return 0;
229 if ( my $code = $class->can($method) ) {
230 return $self->method_action_class->new(
234 reverse => "$class->$method",
236 namespace => Catalyst::Utils::class2prefix(
237 $class, $c->config->{case_sensitive}
244 qq/Couldn't forward to "$class". Does not implement "$method"/;
246 $c->log->debug($error)
252 =head2 $self->prepare_action($c)
254 Find an dispatch type that matches $c->req->path, and set args from it.
259 my ( $self, $c ) = @_;
260 my $path = $c->req->path;
261 my @path = split /\//, $c->req->path;
262 $c->req->args( \my @args );
264 unshift( @path, '' ); # Root action
266 DESCEND: while (@path) {
267 $path = join '/', @path;
270 $path = '' if $path eq '/'; # Root action
272 # Check out dispatch types to see if any will handle the path at
275 foreach my $type ( @{ $self->dispatch_types } ) {
276 last DESCEND if $type->match( $c, $path );
279 # If not, move the last part path to args
280 my $arg = pop(@path);
281 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
285 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for @{$c->req->captures||[]};
287 $c->log->debug( 'Path is "' . $c->req->match . '"' )
288 if ( $c->debug && $c->req->match );
290 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
291 if ( $c->debug && @args );
294 =head2 $self->get_action( $action, $namespace )
296 returns a named action from a given namespace.
301 my ( $self, $name, $namespace ) = @_;
304 $namespace = join( "/", grep { length } split '/', $namespace || "" );
306 return $self->action_hash->{"$namespace/$name"};
309 =head2 $self->get_action_by_path( $path );
311 Returns the named action by its full path.
315 sub get_action_by_path {
316 my ( $self, $path ) = @_;
318 $path = "/$path" unless $path =~ /\//;
319 $self->action_hash->{$path};
322 =head2 $self->get_actions( $c, $action, $namespace )
327 my ( $self, $c, $action, $namespace ) = @_;
328 return [] unless $action;
330 $namespace = join( "/", grep { length } split '/', $namespace || "" );
332 my @match = $self->get_containers($namespace);
334 return map { $_->get_action($action) } @match;
337 =head2 $self->get_containers( $namespace )
339 Return all the action containers for a given namespace, inclusive
344 my ( $self, $namespace ) = @_;
346 $namespace = '' if $namespace eq '/';
350 if ( length $namespace ) {
352 push @containers, $self->container_hash->{$namespace};
353 } while ( $namespace =~ s#/[^/]+$## );
356 return reverse grep { defined } @containers, $self->container_hash->{''};
358 my @parts = split '/', $namespace;
361 =head2 $self->uri_for_action($action, \@captures)
363 Takes a Catalyst::Action object and action parameters and returns a URI
364 part such that if $c->req->path were this URI part, this action would be
365 dispatched to with $c->req->captures set to the supplied arrayref.
367 If the action object is not available for external dispatch or the dispatcher
368 cannot determine an appropriate URI, this method will return undef.
373 my ( $self, $action, $captures) = @_;
375 foreach my $dispatch_type ( @{ $self->dispatch_types } ) {
376 my $uri = $dispatch_type->uri_for_action( $action, $captures );
377 return( $uri eq '' ? '/' : $uri )
383 =head2 $self->register( $c, $action )
385 Make sure all required dispatch types for this action are loaded, then
386 pass the action to our dispatch types so they can register it if required.
387 Also, set up the tree with the action containers.
392 my ( $self, $c, $action ) = @_;
394 my $registered = $self->registered_dispatch_types;
397 foreach my $key ( keys %{ $action->attributes } ) {
398 next if $key eq 'Private';
399 my $class = "Catalyst::DispatchType::$key";
400 unless ( $registered->{$class} ) {
401 eval "require $class";
402 push( @{ $self->dispatch_types }, $class->new ) unless $@;
403 $registered->{$class} = 1;
407 # Pass the action to our dispatch types so they can register it if reqd.
408 foreach my $type ( @{ $self->dispatch_types } ) {
409 $type->register( $c, $action );
412 my $namespace = $action->namespace;
413 my $name = $action->name;
415 my $container = $self->_find_or_create_action_container($namespace);
417 # Set the method value
418 $container->add_action($action);
420 $self->action_hash->{"$namespace/$name"} = $action;
421 $self->container_hash->{$namespace} = $container;
424 sub _find_or_create_action_container {
425 my ( $self, $namespace ) = @_;
427 my $tree ||= $self->tree;
429 return $tree->getNodeValue unless $namespace;
431 my @namespace = split '/', $namespace;
432 return $self->_find_or_create_namespace_node( $tree, @namespace )
436 sub _find_or_create_namespace_node {
437 my ( $self, $parent, $part, @namespace ) = @_;
439 return $parent unless $part;
442 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
445 my $container = Catalyst::ActionContainer->new($part);
446 $parent->addChild( $child = Tree::Simple->new($container) );
449 $self->_find_or_create_namespace_node( $child, @namespace );
452 =head2 $self->setup_actions( $class, $context )
458 my ( $self, $c ) = @_;
460 $self->dispatch_types( [] );
461 $self->registered_dispatch_types( {} );
462 $self->method_action_class('Catalyst::Action');
463 $self->action_container_class('Catalyst::ActionContainer');
466 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
467 @{ $self->registered_dispatch_types }{@classes} = (1) x @classes;
469 foreach my $comp ( values %{ $c->components } ) {
470 $comp->register_actions($c) if $comp->can('register_actions');
473 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
475 return unless $c->debug;
477 my $privates = Text::SimpleTable->new(
485 my ( $walker, $parent, $prefix ) = @_;
486 $prefix .= $parent->getNodeValue || '';
487 $prefix .= '/' unless $prefix =~ /\/$/;
488 my $node = $parent->getNodeValue->actions;
490 for my $action ( keys %{$node} ) {
491 my $action_obj = $node->{$action};
493 if ( ( $action =~ /^_.*/ )
494 && ( !$c->config->{show_internal_actions} ) );
495 $privates->row( "$prefix$action", $action_obj->class, $action );
499 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
502 $walker->( $walker, $self->tree, '' );
503 $c->log->debug( "Loaded Private actions:\n" . $privates->draw )
506 # List all public actions
507 $_->list($c) for @{ $self->dispatch_types };
510 sub _load_dispatch_types {
511 my ( $self, @types ) = @_;
515 # Preload action types
516 for my $type (@types) {
518 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
519 eval "require $class";
520 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
522 push @{ $self->dispatch_types }, $class->new;
524 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.