1 package Catalyst::Dispatcher;
6 use Catalyst::Exception;
9 use Catalyst::ActionContainer;
10 use Catalyst::DispatchType::Default;
11 use Catalyst::DispatchType::Index;
12 use Text::SimpleTable;
14 use Tree::Simple::Visitor::FindByPath;
18 use overload '""' => sub { return ref(shift) }, fallback => 1;
21 # Preload these action types
22 our @PRELOAD = qw/Index Path Regex/;
24 # Postload these action types
25 our @POSTLOAD = qw/Default/;
27 has _tree => (is => 'rw');
28 has _dispatch_types => (is => 'rw');
29 has _registered_dispatch_types => (is => 'rw');
30 has _method_action_class => (is => 'rw');
31 has _action_container_class => (is => 'rw');
32 has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
33 has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
34 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
35 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
41 Catalyst::Dispatcher - The Catalyst Dispatcher
49 This is the class that maps public urls to actions in your Catalyst
50 application based on the attributes you set.
56 Construct a new dispatcher.
61 my ($self, $params) = @_;
64 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
66 $self->_tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
69 =head2 $self->preload_dispatch_types
71 An arrayref of pre-loaded dispatchtype classes
73 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
74 To use a custom class outside the regular C<Catalyst> namespace, prefix
75 it with a C<+>, like so:
79 =head2 $self->postload_dispatch_types
81 An arrayref of post-loaded dispatchtype classes
83 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
84 To use a custom class outside the regular C<Catalyst> namespace, prefix
85 it with a C<+>, like so:
89 =head2 $self->detach( $c, $command [, \@arguments ] )
91 Documented in L<Catalyst>
96 my ( $self, $c, $command, @args ) = @_;
97 $c->forward( $command, @args ) if $command;
98 die $Catalyst::DETACH;
101 =head2 $self->dispatch($c)
103 Delegate the dispatch to the action that matched the url, or return a
104 message about unknown resource
110 my ( $self, $c ) = @_;
111 if ( my $action = $c->action ) {
112 $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
116 my $path = $c->req->path;
118 ? qq/Unknown resource "$path"/
119 : "No default action defined";
120 $c->log->error($error) if $c->debug;
125 =head2 $self->forward( $c, $command [, \@arguments ] )
127 Documented in L<Catalyst>
132 my ( $self, $c, $command, @extra_params ) = @_;
135 $c->log->debug('Nothing to forward to') if $c->debug;
141 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
142 @args = @{ pop @extra_params }
144 # this is a copy, it may take some abuse from ->_invoke_as_path if the path had trailing parts
145 @args = @{ $c->request->arguments };
150 # forward to a string path ("/foo/bar/gorch") or action object which stringifies to that
151 $action = $self->_invoke_as_path( $c, "$command", \@args );
153 # forward to a component ( "MyApp::*::Foo" or $c->component("...") - a path or an object)
155 my $method = @extra_params ? $extra_params[0] : "process";
156 $action = $self->_invoke_as_component( $c, $command, $method );
162 qq/Couldn't forward to command "$command": /
163 . qq/Invalid action or component./;
165 $c->log->debug($error) if $c->debug;
171 no warnings 'recursion';
173 local $c->request->{arguments} = \@args;
174 $action->dispatch( $c );
179 sub _action_rel2abs {
180 my ( $self, $c, $path ) = @_;
182 unless ( $path =~ m#^/# ) {
183 my $namespace = $c->stack->[-1]->namespace;
184 $path = "$namespace/$path";
191 sub _invoke_as_path {
192 my ( $self, $c, $rel_path, $args ) = @_;
194 my $path = $self->_action_rel2abs( $c, $rel_path );
196 my ( $tail, @extra_args );
197 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
198 { # allow $path to be empty
199 if ( my $action = $c->get_action( $tail, $path ) ) {
200 push @$args, @extra_args;
206 ; # if a match on the global namespace failed then the whole lookup failed
209 unshift @extra_args, $tail;
213 sub _find_component_class {
214 my ( $self, $c, $component ) = @_;
216 return ref($component)
217 || ref( $c->component($component) )
218 || $c->component($component);
221 sub _invoke_as_component {
222 my ( $self, $c, $component, $method ) = @_;
224 my $class = $self->_find_component_class( $c, $component ) || return 0;
226 if ( my $code = $class->can($method) ) {
227 return $self->_method_action_class->new(
231 reverse => "$class->$method",
233 namespace => Catalyst::Utils::class2prefix(
234 $class, $c->config->{case_sensitive}
241 qq/Couldn't forward to "$class". Does not implement "$method"/;
243 $c->log->debug($error)
249 =head2 $self->prepare_action($c)
251 Find an dispatch type that matches $c->req->path, and set args from it.
256 my ( $self, $c ) = @_;
258 my $path = $req->path;
259 my @path = split /\//, $req->path;
260 $req->args( \my @args );
262 unshift( @path, '' ); # Root action
264 DESCEND: while (@path) {
265 $path = join '/', @path;
268 $path = '' if $path eq '/'; # Root action
270 # Check out dispatch types to see if any will handle the path at
273 foreach my $type ( @{ $self->_dispatch_types } ) {
274 last DESCEND if $type->match( $c, $path );
277 # If not, move the last part path to args
278 my $arg = pop(@path);
279 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
283 #Moose todo: This seems illegible, even if efficient.
284 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
286 $c->log->debug( 'Path is "' . $req->match . '"' )
287 if ( $c->debug && $req->match );
289 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
290 if ( $c->debug && @args );
293 =head2 $self->get_action( $action, $namespace )
295 returns a named action from a given namespace.
300 my ( $self, $name, $namespace ) = @_;
303 $namespace = join( "/", grep { length } split '/', $namespace || "" );
305 return $self->_action_hash->{"${namespace}/${name}"};
308 =head2 $self->get_action_by_path( $path );
310 Returns the named action by its full path.
314 sub get_action_by_path {
315 my ( $self, $path ) = @_;
317 $path = "/$path" unless $path =~ /\//;
318 $self->_action_hash->{$path};
321 =head2 $self->get_actions( $c, $action, $namespace )
326 my ( $self, $c, $action, $namespace ) = @_;
327 return [] unless $action;
329 $namespace = join( "/", grep { length } split '/', $namespace || "" );
331 my @match = $self->get_containers($namespace);
333 return map { $_->get_action($action) } @match;
336 =head2 $self->get_containers( $namespace )
338 Return all the action containers for a given namespace, inclusive
343 my ( $self, $namespace ) = @_;
345 $namespace = '' if $namespace eq '/';
349 if ( length $namespace ) {
351 push @containers, $self->_container_hash->{$namespace};
352 } while ( $namespace =~ s#/[^/]+$## );
355 return reverse grep { defined } @containers, $self->_container_hash->{''};
357 #return (split '/', $namespace); # isnt this more clear?
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;
396 #my $priv = 0; #seems to be unused
397 foreach my $key ( keys %{ $action->attributes } ) {
398 next if $key eq 'Private';
399 my $class = "Catalyst::DispatchType::$key";
400 unless ( $registered->{$class} ) {
401 #some error checking rethrowing here wouldn't hurt.
402 eval { Class::MOP::load_class($class) };
403 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
404 $registered->{$class} = 1;
408 # Pass the action to our dispatch types so they can register it if reqd.
409 foreach my $type ( @{ $self->_dispatch_types } ) {
410 $type->register( $c, $action );
413 my $namespace = $action->namespace;
414 my $name = $action->name;
416 my $container = $self->_find_or_create_action_container($namespace);
418 # Set the method value
419 $container->add_action($action);
421 $self->_action_hash->{"$namespace/$name"} = $action;
422 $self->_container_hash->{$namespace} = $container;
425 sub _find_or_create_action_container {
426 my ( $self, $namespace ) = @_;
428 my $tree ||= $self->_tree;
430 return $tree->getNodeValue unless $namespace;
432 my @namespace = split '/', $namespace;
433 return $self->_find_or_create_namespace_node( $tree, @namespace )
437 sub _find_or_create_namespace_node {
438 my ( $self, $parent, $part, @namespace ) = @_;
440 return $parent unless $part;
443 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
446 my $container = Catalyst::ActionContainer->new($part);
447 $parent->addChild( $child = Tree::Simple->new($container) );
450 $self->_find_or_create_namespace_node( $child, @namespace );
453 =head2 $self->setup_actions( $class, $context )
459 my ( $self, $c ) = @_;
461 $self->_dispatch_types( [] );
462 $self->_registered_dispatch_types( {} );
463 $self->_method_action_class('Catalyst::Action');
464 $self->_action_container_class('Catalyst::ActionContainer');
467 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
468 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
470 foreach my $comp ( values %{ $c->components } ) {
471 $comp->register_actions($c) if $comp->can('register_actions');
474 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
476 return unless $c->debug;
478 my $privates = Text::SimpleTable->new(
486 my ( $walker, $parent, $prefix ) = @_;
487 $prefix .= $parent->getNodeValue || '';
488 $prefix .= '/' unless $prefix =~ /\/$/;
489 my $node = $parent->getNodeValue->actions;
491 for my $action ( keys %{$node} ) {
492 my $action_obj = $node->{$action};
494 if ( ( $action =~ /^_.*/ )
495 && ( !$c->config->{show_internal_actions} ) );
496 $privates->row( "$prefix$action", $action_obj->class, $action );
500 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
503 $walker->( $walker, $self->_tree, '' );
504 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
507 # List all public actions
508 $_->list($c) for @{ $self->_dispatch_types };
511 sub _load_dispatch_types {
512 my ( $self, @types ) = @_;
516 # Preload action types
517 for my $type (@types) {
519 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
520 #eval "require $class";
521 eval { Class::MOP::load_class($class) };
522 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
524 push @{ $self->_dispatch_types }, $class->new;
526 push @loaded, $class;
538 Sebastian Riedel, C<sri@cpan.org>
539 Matt S Trout, C<mst@shadowcatsystems.co.uk>
543 This program is free software, you can redistribute it and/or modify it under
544 the same terms as Perl itself.