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 #moose todo: reaching inside another object is bad
174 local $c->request->{arguments} = \@args;
175 $action->dispatch( $c );
180 sub _action_rel2abs {
181 my ( $self, $c, $path ) = @_;
183 unless ( $path =~ m#^/# ) {
184 my $namespace = $c->stack->[-1]->namespace;
185 $path = "$namespace/$path";
192 sub _invoke_as_path {
193 my ( $self, $c, $rel_path, $args ) = @_;
195 my $path = $self->_action_rel2abs( $c, $rel_path );
197 my ( $tail, @extra_args );
198 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
199 { # allow $path to be empty
200 if ( my $action = $c->get_action( $tail, $path ) ) {
201 push @$args, @extra_args;
207 ; # if a match on the global namespace failed then the whole lookup failed
210 unshift @extra_args, $tail;
214 sub _find_component_class {
215 my ( $self, $c, $component ) = @_;
217 return ref($component)
218 || ref( $c->component($component) )
219 || $c->component($component);
222 sub _invoke_as_component {
223 my ( $self, $c, $component, $method ) = @_;
225 my $class = $self->_find_component_class( $c, $component ) || return 0;
227 if ( my $code = $class->can($method) ) {
228 return $self->_method_action_class->new(
232 reverse => "$class->$method",
234 namespace => Catalyst::Utils::class2prefix(
235 $class, $c->config->{case_sensitive}
242 qq/Couldn't forward to "$class". Does not implement "$method"/;
244 $c->log->debug($error)
250 =head2 $self->prepare_action($c)
252 Find an dispatch type that matches $c->req->path, and set args from it.
257 my ( $self, $c ) = @_;
259 my $path = $req->path;
260 my @path = split /\//, $req->path;
261 $req->args( \my @args );
263 unshift( @path, '' ); # Root action
265 DESCEND: while (@path) {
266 $path = join '/', @path;
269 $path = '' if $path eq '/'; # Root action
271 # Check out dispatch types to see if any will handle the path at
274 foreach my $type ( @{ $self->_dispatch_types } ) {
275 last DESCEND if $type->match( $c, $path );
278 # If not, move the last part path to args
279 my $arg = pop(@path);
280 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
284 #Moose todo: This seems illegible, even if efficient.
285 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
287 $c->log->debug( 'Path is "' . $req->match . '"' )
288 if ( $c->debug && $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 #return (split '/', $namespace); # isnt this more clear?
359 my @parts = split '/', $namespace;
362 =head2 $self->uri_for_action($action, \@captures)
364 Takes a Catalyst::Action object and action parameters and returns a URI
365 part such that if $c->req->path were this URI part, this action would be
366 dispatched to with $c->req->captures set to the supplied arrayref.
368 If the action object is not available for external dispatch or the dispatcher
369 cannot determine an appropriate URI, this method will return undef.
374 my ( $self, $action, $captures) = @_;
376 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
377 my $uri = $dispatch_type->uri_for_action( $action, $captures );
378 return( $uri eq '' ? '/' : $uri )
384 =head2 $self->register( $c, $action )
386 Make sure all required dispatch types for this action are loaded, then
387 pass the action to our dispatch types so they can register it if required.
388 Also, set up the tree with the action containers.
393 my ( $self, $c, $action ) = @_;
395 my $registered = $self->_registered_dispatch_types;
397 #my $priv = 0; #seems to be unused
398 foreach my $key ( keys %{ $action->attributes } ) {
399 next if $key eq 'Private';
400 my $class = "Catalyst::DispatchType::$key";
401 unless ( $registered->{$class} ) {
402 #some error checking rethrowing here wouldn't hurt.
403 eval { Class::MOP::load_class($class) };
404 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
405 $registered->{$class} = 1;
409 # Pass the action to our dispatch types so they can register it if reqd.
410 foreach my $type ( @{ $self->_dispatch_types } ) {
411 $type->register( $c, $action );
414 my $namespace = $action->namespace;
415 my $name = $action->name;
417 my $container = $self->_find_or_create_action_container($namespace);
419 # Set the method value
420 $container->add_action($action);
422 $self->_action_hash->{"$namespace/$name"} = $action;
423 $self->_container_hash->{$namespace} = $container;
426 sub _find_or_create_action_container {
427 my ( $self, $namespace ) = @_;
429 my $tree ||= $self->_tree;
431 return $tree->getNodeValue unless $namespace;
433 my @namespace = split '/', $namespace;
434 return $self->_find_or_create_namespace_node( $tree, @namespace )
438 sub _find_or_create_namespace_node {
439 my ( $self, $parent, $part, @namespace ) = @_;
441 return $parent unless $part;
444 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
447 my $container = Catalyst::ActionContainer->new($part);
448 $parent->addChild( $child = Tree::Simple->new($container) );
451 $self->_find_or_create_namespace_node( $child, @namespace );
454 =head2 $self->setup_actions( $class, $context )
460 my ( $self, $c ) = @_;
462 $self->_dispatch_types( [] );
463 $self->_registered_dispatch_types( {} );
464 $self->_method_action_class('Catalyst::Action');
465 $self->_action_container_class('Catalyst::ActionContainer');
468 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
469 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
471 foreach my $comp ( values %{ $c->components } ) {
472 $comp->register_actions($c) if $comp->can('register_actions');
475 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
477 return unless $c->debug;
479 my $privates = Text::SimpleTable->new(
487 my ( $walker, $parent, $prefix ) = @_;
488 $prefix .= $parent->getNodeValue || '';
489 $prefix .= '/' unless $prefix =~ /\/$/;
490 my $node = $parent->getNodeValue->actions;
492 for my $action ( keys %{$node} ) {
493 my $action_obj = $node->{$action};
495 if ( ( $action =~ /^_.*/ )
496 && ( !$c->config->{show_internal_actions} ) );
497 $privates->row( "$prefix$action", $action_obj->class, $action );
501 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
504 $walker->( $walker, $self->_tree, '' );
505 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
508 # List all public actions
509 $_->list($c) for @{ $self->_dispatch_types };
512 sub _load_dispatch_types {
513 my ( $self, @types ) = @_;
517 # Preload action types
518 for my $type (@types) {
520 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
521 #eval "require $class";
522 eval { Class::MOP::load_class($class) };
523 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
525 push @{ $self->_dispatch_types }, $class->new;
527 push @loaded, $class;
533 __PACKAGE__->meta->make_immutable;
541 Sebastian Riedel, C<sri@cpan.org>
542 Matt S Trout, C<mst@shadowcatsystems.co.uk>
546 This program is free software, you can redistribute it and/or modify it under
547 the same terms as Perl itself.