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->go( $c, $command [, \@arguments ] )
170 Documented in L<Catalyst>
176 my ( $c, $command ) = @_;
177 my ( $action, $args ) = $self->_command2action(@_);
179 unless ($action && defined $action->namespace) {
181 qq/Couldn't go to command "$command": /
182 . qq/Invalid action or component./;
184 $c->log->debug($error) if $c->debug;
188 local $c->request->{arguments} = $args;
189 $c->namespace($action->namespace);
196 =head2 $self->forward( $c, $command [, \@arguments ] )
198 Documented in L<Catalyst>
204 my ( $c, $command ) = @_;
205 my ( $action, $args ) = $self->_command2action(@_);
209 qq/Couldn't forward to command "$command": /
210 . qq/Invalid action or component./;
212 $c->log->debug($error) if $c->debug;
216 local $c->request->{arguments} = $args;
217 $action->dispatch( $c );
222 sub _action_rel2abs {
223 my ( $self, $c, $path ) = @_;
225 unless ( $path =~ m#^/# ) {
226 my $namespace = $c->stack->[-1]->namespace;
227 $path = "$namespace/$path";
234 sub _invoke_as_path {
235 my ( $self, $c, $rel_path, $args ) = @_;
237 my $path = $self->_action_rel2abs( $c, $rel_path );
239 my ( $tail, @extra_args );
240 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
241 { # allow $path to be empty
242 if ( my $action = $c->get_action( $tail, $path ) ) {
243 push @$args, @extra_args;
249 ; # if a match on the global namespace failed then the whole lookup failed
252 unshift @extra_args, $tail;
256 sub _find_component_class {
257 my ( $self, $c, $component ) = @_;
259 return ref($component)
260 || ref( $c->component($component) )
261 || $c->component($component);
264 sub _invoke_as_component {
265 my ( $self, $c, $component, $method ) = @_;
267 my $class = $self->_find_component_class( $c, $component ) || return 0;
269 if ( my $code = $class->can($method) ) {
270 return $self->method_action_class->new(
274 reverse => "$class->$method",
276 namespace => Catalyst::Utils::class2prefix(
277 $class, $c->config->{case_sensitive}
284 qq/Couldn't forward to "$class". Does not implement "$method"/;
286 $c->log->debug($error)
292 =head2 $self->prepare_action($c)
294 Find an dispatch type that matches $c->req->path, and set args from it.
299 my ( $self, $c ) = @_;
300 my $path = $c->req->path;
301 my @path = split /\//, $c->req->path;
302 $c->req->args( \my @args );
304 unshift( @path, '' ); # Root action
306 DESCEND: while (@path) {
307 $path = join '/', @path;
310 $path = '' if $path eq '/'; # Root action
312 # Check out dispatch types to see if any will handle the path at
315 foreach my $type ( @{ $self->dispatch_types } ) {
316 last DESCEND if $type->match( $c, $path );
319 # If not, move the last part path to args
320 my $arg = pop(@path);
321 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
325 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$c->req->captures||[]};
327 $c->log->debug( 'Path is "' . $c->req->match . '"' )
328 if ( $c->debug && length $c->req->match );
330 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
331 if ( $c->debug && @args );
334 =head2 $self->get_action( $action, $namespace )
336 returns a named action from a given namespace.
341 my ( $self, $name, $namespace ) = @_;
344 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
346 return $self->action_hash->{"$namespace/$name"};
349 =head2 $self->get_action_by_path( $path );
351 Returns the named action by its full path.
355 sub get_action_by_path {
356 my ( $self, $path ) = @_;
358 $path = "/$path" unless $path =~ /\//;
359 $self->action_hash->{$path};
362 =head2 $self->get_actions( $c, $action, $namespace )
367 my ( $self, $c, $action, $namespace ) = @_;
368 return [] unless $action;
370 $namespace = join( "/", grep { length } split '/', $namespace || "" );
372 my @match = $self->get_containers($namespace);
374 return map { $_->get_action($action) } @match;
377 =head2 $self->get_containers( $namespace )
379 Return all the action containers for a given namespace, inclusive
384 my ( $self, $namespace ) = @_;
386 $namespace = '' if $namespace eq '/';
390 if ( length $namespace ) {
392 push @containers, $self->container_hash->{$namespace};
393 } while ( $namespace =~ s#/[^/]+$## );
396 return reverse grep { defined } @containers, $self->container_hash->{''};
398 my @parts = split '/', $namespace;
401 =head2 $self->uri_for_action($action, \@captures)
403 Takes a Catalyst::Action object and action parameters and returns a URI
404 part such that if $c->req->path were this URI part, this action would be
405 dispatched to with $c->req->captures set to the supplied arrayref.
407 If the action object is not available for external dispatch or the dispatcher
408 cannot determine an appropriate URI, this method will return undef.
413 my ( $self, $action, $captures) = @_;
415 foreach my $dispatch_type ( @{ $self->dispatch_types } ) {
416 my $uri = $dispatch_type->uri_for_action( $action, $captures );
417 return( $uri eq '' ? '/' : $uri )
423 =head2 $self->register( $c, $action )
425 Make sure all required dispatch types for this action are loaded, then
426 pass the action to our dispatch types so they can register it if required.
427 Also, set up the tree with the action containers.
432 my ( $self, $c, $action ) = @_;
434 my $registered = $self->registered_dispatch_types;
437 foreach my $key ( keys %{ $action->attributes } ) {
438 next if $key eq 'Private';
439 my $class = "Catalyst::DispatchType::$key";
440 unless ( $registered->{$class} ) {
441 eval "require $class";
442 push( @{ $self->dispatch_types }, $class->new ) unless $@;
443 $registered->{$class} = 1;
447 # Pass the action to our dispatch types so they can register it if reqd.
448 foreach my $type ( @{ $self->dispatch_types } ) {
449 $type->register( $c, $action );
452 my $namespace = $action->namespace;
453 my $name = $action->name;
455 my $container = $self->_find_or_create_action_container($namespace);
457 # Set the method value
458 $container->add_action($action);
460 $self->action_hash->{"$namespace/$name"} = $action;
461 $self->container_hash->{$namespace} = $container;
464 sub _find_or_create_action_container {
465 my ( $self, $namespace ) = @_;
467 my $tree ||= $self->tree;
469 return $tree->getNodeValue unless $namespace;
471 my @namespace = split '/', $namespace;
472 return $self->_find_or_create_namespace_node( $tree, @namespace )
476 sub _find_or_create_namespace_node {
477 my ( $self, $parent, $part, @namespace ) = @_;
479 return $parent unless $part;
482 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
485 my $container = Catalyst::ActionContainer->new($part);
486 $parent->addChild( $child = Tree::Simple->new($container) );
489 $self->_find_or_create_namespace_node( $child, @namespace );
492 =head2 $self->setup_actions( $class, $context )
498 my ( $self, $c ) = @_;
500 $self->dispatch_types( [] );
501 $self->registered_dispatch_types( {} );
502 $self->method_action_class('Catalyst::Action');
503 $self->action_container_class('Catalyst::ActionContainer');
506 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
507 @{ $self->registered_dispatch_types }{@classes} = (1) x @classes;
509 foreach my $comp ( values %{ $c->components } ) {
510 $comp->register_actions($c) if $comp->can('register_actions');
513 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
515 return unless $c->debug;
517 my $privates = Text::SimpleTable->new(
525 my ( $walker, $parent, $prefix ) = @_;
526 $prefix .= $parent->getNodeValue || '';
527 $prefix .= '/' unless $prefix =~ /\/$/;
528 my $node = $parent->getNodeValue->actions;
530 for my $action ( keys %{$node} ) {
531 my $action_obj = $node->{$action};
533 if ( ( $action =~ /^_.*/ )
534 && ( !$c->config->{show_internal_actions} ) );
535 $privates->row( "$prefix$action", $action_obj->class, $action );
539 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
542 $walker->( $walker, $self->tree, '' );
543 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
546 # List all public actions
547 $_->list($c) for @{ $self->dispatch_types };
550 sub _load_dispatch_types {
551 my ( $self, @types ) = @_;
555 # Preload action types
556 for my $type (@types) {
558 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
559 eval "require $class";
560 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
562 push @{ $self->dispatch_types }, $class->new;
564 push @loaded, $class;
572 Catalyst Contributors, see Catalyst.pm
576 This program is free software, you can redistribute it and/or modify it under
577 the same terms as Perl itself.