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 #do these belong as package vars or should we build these via a builder method?
22 # Preload these action types
23 our @PRELOAD = qw/Index Path Regex/;
25 # Postload these action types
26 our @POSTLOAD = qw/Default/;
28 has _tree => (is => 'rw');
29 has _dispatch_types => (is => 'rw');
30 has _registered_dispatch_types => (is => 'rw');
31 has _method_action_class => (is => 'rw');
32 has _action_container_class => (is => 'rw');
33 has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
34 has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
35 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
36 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
42 Catalyst::Dispatcher - The Catalyst Dispatcher
50 This is the class that maps public urls to actions in your Catalyst
51 application based on the attributes you set.
57 Construct a new dispatcher.
62 my ($self, $params) = @_;
65 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
67 $self->_tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
70 =head2 $self->preload_dispatch_types
72 An arrayref of pre-loaded dispatchtype classes
74 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
75 To use a custom class outside the regular C<Catalyst> namespace, prefix
76 it with a C<+>, like so:
80 =head2 $self->postload_dispatch_types
82 An arrayref of post-loaded dispatchtype classes
84 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
85 To use a custom class outside the regular C<Catalyst> namespace, prefix
86 it with a C<+>, like so:
90 =head2 $self->detach( $c, $command [, \@arguments ] )
92 Documented in L<Catalyst>
97 my ( $self, $c, $command, @args ) = @_;
98 $c->forward( $command, @args ) if $command;
99 die $Catalyst::DETACH;
102 =head2 $self->dispatch($c)
104 Delegate the dispatch to the action that matched the url, or return a
105 message about unknown resource
111 my ( $self, $c ) = @_;
112 if ( my $action = $c->action ) {
113 $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
117 my $path = $c->req->path;
119 ? qq/Unknown resource "$path"/
120 : "No default action defined";
121 $c->log->error($error) if $c->debug;
126 =head2 $self->forward( $c, $command [, \@arguments ] )
128 Documented in L<Catalyst>
133 my ( $self, $c, $command, @extra_params ) = @_;
136 $c->log->debug('Nothing to forward to') if $c->debug;
142 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
143 @args = @{ pop @extra_params }
145 # this is a copy, it may take some abuse from ->_invoke_as_path if the path had trailing parts
146 @args = @{ $c->request->arguments };
151 # forward to a string path ("/foo/bar/gorch") or action object which stringifies to that
152 $action = $self->_invoke_as_path( $c, "$command", \@args );
154 # forward to a component ( "MyApp::*::Foo" or $c->component("...") - a path or an object)
156 my $method = @extra_params ? $extra_params[0] : "process";
157 $action = $self->_invoke_as_component( $c, $command, $method );
163 qq/Couldn't forward to command "$command": /
164 . qq/Invalid action or component./;
166 $c->log->debug($error) if $c->debug;
172 no warnings 'recursion';
174 #moose todo: reaching inside another object is bad
175 local $c->request->{arguments} = \@args;
176 $action->dispatch( $c );
181 sub _action_rel2abs {
182 my ( $self, $c, $path ) = @_;
184 unless ( $path =~ m#^/# ) {
185 my $namespace = $c->stack->[-1]->namespace;
186 $path = "$namespace/$path";
193 sub _invoke_as_path {
194 my ( $self, $c, $rel_path, $args ) = @_;
196 my $path = $self->_action_rel2abs( $c, $rel_path );
198 my ( $tail, @extra_args );
199 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
200 { # allow $path to be empty
201 if ( my $action = $c->get_action( $tail, $path ) ) {
202 push @$args, @extra_args;
208 ; # if a match on the global namespace failed then the whole lookup failed
211 unshift @extra_args, $tail;
215 sub _find_component_class {
216 my ( $self, $c, $component ) = @_;
218 return ref($component)
219 || ref( $c->component($component) )
220 || $c->component($component);
223 sub _invoke_as_component {
224 my ( $self, $c, $component, $method ) = @_;
226 my $class = $self->_find_component_class( $c, $component ) || return 0;
228 if ( my $code = $class->can($method) ) {
229 return $self->_method_action_class->new(
233 reverse => "$class->$method",
235 namespace => Catalyst::Utils::class2prefix(
236 $class, $c->config->{case_sensitive}
243 qq/Couldn't forward to "$class". Does not implement "$method"/;
245 $c->log->debug($error)
251 =head2 $self->prepare_action($c)
253 Find an dispatch type that matches $c->req->path, and set args from it.
258 my ( $self, $c ) = @_;
260 my $path = $req->path;
261 my @path = split /\//, $req->path;
262 $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 #Moose todo: This seems illegible, even if efficient.
286 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
288 $c->log->debug( 'Path is "' . $req->match . '"' )
289 if ( $c->debug && $req->match );
291 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
292 if ( $c->debug && @args );
295 =head2 $self->get_action( $action, $namespace )
297 returns a named action from a given namespace.
302 my ( $self, $name, $namespace ) = @_;
305 $namespace = join( "/", grep { length } split '/', $namespace || "" );
307 return $self->_action_hash->{"${namespace}/${name}"};
310 =head2 $self->get_action_by_path( $path );
312 Returns the named action by its full path.
316 sub get_action_by_path {
317 my ( $self, $path ) = @_;
319 $path = "/$path" unless $path =~ /\//;
320 $self->_action_hash->{$path};
323 =head2 $self->get_actions( $c, $action, $namespace )
328 my ( $self, $c, $action, $namespace ) = @_;
329 return [] unless $action;
331 $namespace = join( "/", grep { length } split '/', $namespace || "" );
333 my @match = $self->get_containers($namespace);
335 return map { $_->get_action($action) } @match;
338 =head2 $self->get_containers( $namespace )
340 Return all the action containers for a given namespace, inclusive
345 my ( $self, $namespace ) = @_;
347 $namespace = '' if $namespace eq '/';
351 if ( length $namespace ) {
353 push @containers, $self->_container_hash->{$namespace};
354 } while ( $namespace =~ s#/[^/]+$## );
357 return reverse grep { defined } @containers, $self->_container_hash->{''};
359 #return (split '/', $namespace); # isnt this more clear?
360 my @parts = split '/', $namespace;
363 =head2 $self->uri_for_action($action, \@captures)
365 Takes a Catalyst::Action object and action parameters and returns a URI
366 part such that if $c->req->path were this URI part, this action would be
367 dispatched to with $c->req->captures set to the supplied arrayref.
369 If the action object is not available for external dispatch or the dispatcher
370 cannot determine an appropriate URI, this method will return undef.
375 my ( $self, $action, $captures) = @_;
377 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
378 my $uri = $dispatch_type->uri_for_action( $action, $captures );
379 return( $uri eq '' ? '/' : $uri )
385 =head2 $self->register( $c, $action )
387 Make sure all required dispatch types for this action are loaded, then
388 pass the action to our dispatch types so they can register it if required.
389 Also, set up the tree with the action containers.
394 my ( $self, $c, $action ) = @_;
396 my $registered = $self->_registered_dispatch_types;
398 #my $priv = 0; #seems to be unused
399 foreach my $key ( keys %{ $action->attributes } ) {
400 next if $key eq 'Private';
401 my $class = "Catalyst::DispatchType::$key";
402 unless ( $registered->{$class} ) {
403 #some error checking rethrowing here wouldn't hurt.
404 eval { Class::MOP::load_class($class) };
405 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
406 $registered->{$class} = 1;
410 # Pass the action to our dispatch types so they can register it if reqd.
411 foreach my $type ( @{ $self->_dispatch_types } ) {
412 $type->register( $c, $action );
415 my $namespace = $action->namespace;
416 my $name = $action->name;
418 my $container = $self->_find_or_create_action_container($namespace);
420 # Set the method value
421 $container->add_action($action);
423 $self->_action_hash->{"$namespace/$name"} = $action;
424 $self->_container_hash->{$namespace} = $container;
427 sub _find_or_create_action_container {
428 my ( $self, $namespace ) = @_;
430 my $tree ||= $self->_tree;
432 return $tree->getNodeValue unless $namespace;
434 my @namespace = split '/', $namespace;
435 return $self->_find_or_create_namespace_node( $tree, @namespace )
439 sub _find_or_create_namespace_node {
440 my ( $self, $parent, $part, @namespace ) = @_;
442 return $parent unless $part;
445 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
448 my $container = Catalyst::ActionContainer->new($part);
449 $parent->addChild( $child = Tree::Simple->new($container) );
452 $self->_find_or_create_namespace_node( $child, @namespace );
455 =head2 $self->setup_actions( $class, $context )
461 my ( $self, $c ) = @_;
463 $self->_dispatch_types( [] );
464 $self->_registered_dispatch_types( {} );
465 $self->_method_action_class('Catalyst::Action');
466 $self->_action_container_class('Catalyst::ActionContainer');
469 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
470 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
472 foreach my $comp ( values %{ $c->components } ) {
473 $comp->register_actions($c) if $comp->can('register_actions');
476 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
478 return unless $c->debug;
480 my $privates = Text::SimpleTable->new(
488 my ( $walker, $parent, $prefix ) = @_;
489 $prefix .= $parent->getNodeValue || '';
490 $prefix .= '/' unless $prefix =~ /\/$/;
491 my $node = $parent->getNodeValue->actions;
493 for my $action ( keys %{$node} ) {
494 my $action_obj = $node->{$action};
496 if ( ( $action =~ /^_.*/ )
497 && ( !$c->config->{show_internal_actions} ) );
498 $privates->row( "$prefix$action", $action_obj->class, $action );
502 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
505 $walker->( $walker, $self->_tree, '' );
506 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
509 # List all public actions
510 $_->list($c) for @{ $self->_dispatch_types };
513 sub _load_dispatch_types {
514 my ( $self, @types ) = @_;
518 # Preload action types
519 for my $type (@types) {
521 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
522 #eval "require $class";
523 eval { Class::MOP::load_class($class) };
524 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
526 push @{ $self->_dispatch_types }, $class->new;
528 push @loaded, $class;
534 __PACKAGE__->meta->make_immutable;
542 Sebastian Riedel, C<sri@cpan.org>
543 Matt S Trout, C<mst@shadowcatsystems.co.uk>
547 This program is free software, you can redistribute it and/or modify it under
548 the same terms as Perl itself.