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;
17 #do these belong as package vars or should we build these via a builder method?
18 # Preload these action types
19 our @PRELOAD = qw/Index Path Regex/;
21 # Postload these action types
22 our @POSTLOAD = qw/Default/;
24 has _tree => (is => 'rw');
25 has _dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
26 has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
27 has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
28 has _action_container_class => (is => 'rw', default => 'Catalyst::ActionContainer');
30 has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
31 has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
32 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
33 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
39 Catalyst::Dispatcher - The Catalyst Dispatcher
47 This is the class that maps public urls to actions in your Catalyst
48 application based on the attributes you set.
54 Construct a new dispatcher.
59 my ($self, $params) = @_;
62 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
64 $self->_tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
67 =head2 $self->preload_dispatch_types
69 An arrayref of pre-loaded dispatchtype classes
71 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
72 To use a custom class outside the regular C<Catalyst> namespace, prefix
73 it with a C<+>, like so:
77 =head2 $self->postload_dispatch_types
79 An arrayref of post-loaded dispatchtype classes
81 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
82 To use a custom class outside the regular C<Catalyst> namespace, prefix
83 it with a C<+>, like so:
87 =head2 $self->detach( $c, $command [, \@arguments ] )
89 Documented in L<Catalyst>
94 my ( $self, $c, $command, @args ) = @_;
95 $c->forward( $command, @args ) if $command;
96 die $Catalyst::DETACH;
99 =head2 $self->dispatch($c)
101 Delegate the dispatch to the action that matched the url, or return a
102 message about unknown resource
108 my ( $self, $c ) = @_;
109 if ( my $action = $c->action ) {
110 $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
114 my $path = $c->req->path;
116 ? qq/Unknown resource "$path"/
117 : "No default action defined";
118 $c->log->error($error) if $c->debug;
123 =head2 $self->forward( $c, $command [, \@arguments ] )
125 Documented in L<Catalyst>
130 my ( $self, $c, $command, @extra_params ) = @_;
133 $c->log->debug('Nothing to forward to') if $c->debug;
139 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
140 @args = @{ pop @extra_params }
142 # this is a copy, it may take some abuse from ->_invoke_as_path if the path had trailing parts
143 @args = @{ $c->request->arguments };
148 # forward to a string path ("/foo/bar/gorch") or action object which stringifies to that
149 $action = $self->_invoke_as_path( $c, "$command", \@args );
151 # forward to a component ( "MyApp::*::Foo" or $c->component("...") - a path or an object)
153 my $method = @extra_params ? $extra_params[0] : "process";
154 $action = $self->_invoke_as_component( $c, $command, $method );
160 qq/Couldn't forward to command "$command": /
161 . qq/Invalid action or component./;
163 $c->log->debug($error) if $c->debug;
169 no warnings 'recursion';
171 my $orig_args = $c->request->arguments();
172 $c->request->arguments(\@args);
173 $action->dispatch( $c );
174 $c->request->arguments($orig_args);
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 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
285 $c->log->debug( 'Path is "' . $req->match . '"' )
286 if ( $c->debug && $req->match );
288 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
289 if ( $c->debug && @args );
292 =head2 $self->get_action( $action, $namespace )
294 returns a named action from a given namespace.
299 my ( $self, $name, $namespace ) = @_;
302 $namespace = join( "/", grep { length } split '/', $namespace || "" );
304 return $self->_action_hash->{"${namespace}/${name}"};
307 =head2 $self->get_action_by_path( $path );
309 Returns the named action by its full path.
313 sub get_action_by_path {
314 my ( $self, $path ) = @_;
316 $path = "/$path" unless $path =~ /\//;
317 $self->_action_hash->{$path};
320 =head2 $self->get_actions( $c, $action, $namespace )
325 my ( $self, $c, $action, $namespace ) = @_;
326 return [] unless $action;
328 $namespace = join( "/", grep { length } split '/', $namespace || "" );
330 my @match = $self->get_containers($namespace);
332 return map { $_->get_action($action) } @match;
335 =head2 $self->get_containers( $namespace )
337 Return all the action containers for a given namespace, inclusive
342 my ( $self, $namespace ) = @_;
344 $namespace = '' if $namespace eq '/';
348 if ( length $namespace ) {
350 push @containers, $self->_container_hash->{$namespace};
351 } while ( $namespace =~ s#/[^/]+$## );
354 return reverse grep { defined } @containers, $self->_container_hash->{''};
356 #return (split '/', $namespace); # isnt this more clear?
357 my @parts = split '/', $namespace;
360 =head2 $self->uri_for_action($action, \@captures)
362 Takes a Catalyst::Action object and action parameters and returns a URI
363 part such that if $c->req->path were this URI part, this action would be
364 dispatched to with $c->req->captures set to the supplied arrayref.
366 If the action object is not available for external dispatch or the dispatcher
367 cannot determine an appropriate URI, this method will return undef.
372 my ( $self, $action, $captures) = @_;
374 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
375 my $uri = $dispatch_type->uri_for_action( $action, $captures );
376 return( $uri eq '' ? '/' : $uri )
382 =head2 $self->register( $c, $action )
384 Make sure all required dispatch types for this action are loaded, then
385 pass the action to our dispatch types so they can register it if required.
386 Also, set up the tree with the action containers.
391 my ( $self, $c, $action ) = @_;
393 my $registered = $self->_registered_dispatch_types;
395 #my $priv = 0; #seems to be unused
396 foreach my $key ( keys %{ $action->attributes } ) {
397 next if $key eq 'Private';
398 my $class = "Catalyst::DispatchType::$key";
399 unless ( $registered->{$class} ) {
400 #some error checking rethrowing here wouldn't hurt.
401 eval { Class::MOP::load_class($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 ) = @_;
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}";
516 eval { Class::MOP::load_class($class) };
517 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
519 push @{ $self->_dispatch_types }, $class->new;
521 push @loaded, $class;
528 __PACKAGE__->meta->make_immutable;
536 Sebastian Riedel, C<sri@cpan.org>
537 Matt S Trout, C<mst@shadowcatsystems.co.uk>
541 This program is free software, you can redistribute it and/or modify it under
542 the same terms as Perl itself.