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 # $self->_command2action( $c, $command [, \@arguments ] )
131 # Search for an action, from the command and returns C<($action, $args)> on
132 # success. Returns C<(0)> on error.
134 sub _command2action {
135 my ( $self, $c, $command, @extra_params ) = @_;
138 $c->log->debug('Nothing to go to') if $c->debug;
144 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
145 @args = @{ pop @extra_params }
147 # this is a copy, it may take some abuse from
148 # ->_invoke_as_path if the path had trailing parts
149 @args = @{ $c->request->arguments };
154 # go to a string path ("/foo/bar/gorch")
155 # or action object which stringifies to that
156 $action = $self->_invoke_as_path( $c, "$command", \@args );
158 # go to a component ( "MyApp::*::Foo" or $c->component("...")
159 # - a path or an object)
161 my $method = @extra_params ? $extra_params[0] : "process";
162 $action = $self->_invoke_as_component( $c, $command, $method );
165 return $action, \@args;
168 =head2 $self->forward( $c, $command [, \@arguments ] )
170 Documented in L<Catalyst>
176 my ( $c, $command ) = @_;
177 my ( $action, $args ) = $self->_command2action(@_);
181 qq/Couldn't forward to command "$command": /
182 . qq/Invalid action or component./;
184 $c->log->debug($error) if $c->debug;
188 local $c->request->{arguments} = $args;
189 $action->dispatch( $c );
194 sub _action_rel2abs {
195 my ( $self, $c, $path ) = @_;
197 unless ( $path =~ m#^/# ) {
198 my $namespace = $c->stack->[-1]->namespace;
199 $path = "$namespace/$path";
206 sub _invoke_as_path {
207 my ( $self, $c, $rel_path, $args ) = @_;
209 my $path = $self->_action_rel2abs( $c, $rel_path );
211 my ( $tail, @extra_args );
212 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
213 { # allow $path to be empty
214 if ( my $action = $c->get_action( $tail, $path ) ) {
215 push @$args, @extra_args;
221 ; # if a match on the global namespace failed then the whole lookup failed
224 unshift @extra_args, $tail;
228 sub _find_component_class {
229 my ( $self, $c, $component ) = @_;
231 return ref($component)
232 || ref( $c->component($component) )
233 || $c->component($component);
236 sub _invoke_as_component {
237 my ( $self, $c, $component, $method ) = @_;
239 my $class = $self->_find_component_class( $c, $component ) || return 0;
241 if ( my $code = $class->can($method) ) {
242 return $self->method_action_class->new(
246 reverse => "$class->$method",
248 namespace => Catalyst::Utils::class2prefix(
249 $class, $c->config->{case_sensitive}
256 qq/Couldn't forward to "$class". Does not implement "$method"/;
258 $c->log->debug($error)
264 =head2 $self->prepare_action($c)
266 Find an dispatch type that matches $c->req->path, and set args from it.
271 my ( $self, $c ) = @_;
272 my $path = $c->req->path;
273 my @path = split /\//, $c->req->path;
274 $c->req->args( \my @args );
276 unshift( @path, '' ); # Root action
278 DESCEND: while (@path) {
279 $path = join '/', @path;
282 $path = '' if $path eq '/'; # Root action
284 # Check out dispatch types to see if any will handle the path at
287 foreach my $type ( @{ $self->dispatch_types } ) {
288 last DESCEND if $type->match( $c, $path );
291 # If not, move the last part path to args
292 my $arg = pop(@path);
293 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
297 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$c->req->captures||[]};
299 $c->log->debug( 'Path is "' . $c->req->match . '"' )
300 if ( $c->debug && length $c->req->match );
302 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
303 if ( $c->debug && @args );
306 =head2 $self->get_action( $action, $namespace )
308 returns a named action from a given namespace.
313 my ( $self, $name, $namespace ) = @_;
316 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
318 return $self->action_hash->{"$namespace/$name"};
321 =head2 $self->get_action_by_path( $path );
323 Returns the named action by its full path.
327 sub get_action_by_path {
328 my ( $self, $path ) = @_;
330 $path = "/$path" unless $path =~ /\//;
331 $self->action_hash->{$path};
334 =head2 $self->get_actions( $c, $action, $namespace )
339 my ( $self, $c, $action, $namespace ) = @_;
340 return [] unless $action;
342 $namespace = join( "/", grep { length } split '/', $namespace || "" );
344 my @match = $self->get_containers($namespace);
346 return map { $_->get_action($action) } @match;
349 =head2 $self->get_containers( $namespace )
351 Return all the action containers for a given namespace, inclusive
356 my ( $self, $namespace ) = @_;
358 $namespace = '' if $namespace eq '/';
362 if ( length $namespace ) {
364 push @containers, $self->container_hash->{$namespace};
365 } while ( $namespace =~ s#/[^/]+$## );
368 return reverse grep { defined } @containers, $self->container_hash->{''};
370 my @parts = split '/', $namespace;
373 =head2 $self->uri_for_action($action, \@captures)
375 Takes a Catalyst::Action object and action parameters and returns a URI
376 part such that if $c->req->path were this URI part, this action would be
377 dispatched to with $c->req->captures set to the supplied arrayref.
379 If the action object is not available for external dispatch or the dispatcher
380 cannot determine an appropriate URI, this method will return undef.
385 my ( $self, $action, $captures) = @_;
387 foreach my $dispatch_type ( @{ $self->dispatch_types } ) {
388 my $uri = $dispatch_type->uri_for_action( $action, $captures );
389 return( $uri eq '' ? '/' : $uri )
395 =head2 $self->register( $c, $action )
397 Make sure all required dispatch types for this action are loaded, then
398 pass the action to our dispatch types so they can register it if required.
399 Also, set up the tree with the action containers.
404 my ( $self, $c, $action ) = @_;
406 my $registered = $self->registered_dispatch_types;
409 foreach my $key ( keys %{ $action->attributes } ) {
410 next if $key eq 'Private';
411 my $class = "Catalyst::DispatchType::$key";
412 unless ( $registered->{$class} ) {
413 eval "require $class";
414 push( @{ $self->dispatch_types }, $class->new ) unless $@;
415 $registered->{$class} = 1;
419 # Pass the action to our dispatch types so they can register it if reqd.
420 foreach my $type ( @{ $self->dispatch_types } ) {
421 $type->register( $c, $action );
424 my $namespace = $action->namespace;
425 my $name = $action->name;
427 my $container = $self->_find_or_create_action_container($namespace);
429 # Set the method value
430 $container->add_action($action);
432 $self->action_hash->{"$namespace/$name"} = $action;
433 $self->container_hash->{$namespace} = $container;
436 sub _find_or_create_action_container {
437 my ( $self, $namespace ) = @_;
439 my $tree ||= $self->tree;
441 return $tree->getNodeValue unless $namespace;
443 my @namespace = split '/', $namespace;
444 return $self->_find_or_create_namespace_node( $tree, @namespace )
448 sub _find_or_create_namespace_node {
449 my ( $self, $parent, $part, @namespace ) = @_;
451 return $parent unless $part;
454 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
457 my $container = Catalyst::ActionContainer->new($part);
458 $parent->addChild( $child = Tree::Simple->new($container) );
461 $self->_find_or_create_namespace_node( $child, @namespace );
464 =head2 $self->setup_actions( $class, $context )
470 my ( $self, $c ) = @_;
472 $self->dispatch_types( [] );
473 $self->registered_dispatch_types( {} );
474 $self->method_action_class('Catalyst::Action');
475 $self->action_container_class('Catalyst::ActionContainer');
478 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
479 @{ $self->registered_dispatch_types }{@classes} = (1) x @classes;
481 foreach my $comp ( values %{ $c->components } ) {
482 $comp->register_actions($c) if $comp->can('register_actions');
485 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
487 return unless $c->debug;
489 my $privates = Text::SimpleTable->new(
497 my ( $walker, $parent, $prefix ) = @_;
498 $prefix .= $parent->getNodeValue || '';
499 $prefix .= '/' unless $prefix =~ /\/$/;
500 my $node = $parent->getNodeValue->actions;
502 for my $action ( keys %{$node} ) {
503 my $action_obj = $node->{$action};
505 if ( ( $action =~ /^_.*/ )
506 && ( !$c->config->{show_internal_actions} ) );
507 $privates->row( "$prefix$action", $action_obj->class, $action );
511 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
514 $walker->( $walker, $self->tree, '' );
515 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
518 # List all public actions
519 $_->list($c) for @{ $self->dispatch_types };
522 sub _load_dispatch_types {
523 my ( $self, @types ) = @_;
527 # Preload action types
528 for my $type (@types) {
530 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
531 eval "require $class";
532 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
534 push @{ $self->dispatch_types }, $class->new;
536 push @loaded, $class;
544 Catalyst Contributors, see Catalyst.pm
548 This program is free software, you can redistribute it and/or modify it under
549 the same terms as Perl itself.