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 use Data::Dumper; warn Dumper( $c->action, $c->action->namespace );
118 $c->forward( join( '/', '', $c->action->namespace, '_DISPATCH' ) );
122 my $path = $c->req->path;
124 ? qq/Unknown resource "$path"/
125 : "No default action defined";
126 $c->log->error($error) if $c->debug;
131 # $self->_command2action( $c, $command [, \@arguments ] )
132 # Search for an action, from the command and returns C<($action, $args)> on
133 # success. Returns C<(0)> on error.
135 sub _command2action {
136 my ( $self, $c, $command, @extra_params ) = @_;
139 $c->log->debug('Nothing to go to') if $c->debug;
145 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
146 @args = @{ pop @extra_params }
148 # this is a copy, it may take some abuse from
149 # ->_invoke_as_path if the path had trailing parts
150 @args = @{ $c->request->arguments };
155 # go to a string path ("/foo/bar/gorch")
156 # or action object which stringifies to that
157 $action = $self->_invoke_as_path( $c, "$command", \@args );
159 # go to a component ( "MyApp::*::Foo" or $c->component("...")
160 # - a path or an object)
162 my $method = @extra_params ? $extra_params[0] : "process";
163 $action = $self->_invoke_as_component( $c, $command, $method );
166 return $action, \@args;
169 =head2 $self->go( $c, $command [, \@arguments ] )
171 Documented in L<Catalyst>
177 my ( $c, $command ) = @_;
178 my ( $action, $args ) = $self->_command2action(@_);
182 qq/Couldn't go to command "$command": /
183 . qq/Invalid action or component./;
185 $c->log->debug($error) if $c->debug;
189 local $c->request->{arguments} = $args;
190 $c->namespace($action->namespace);
197 =head2 $self->forward( $c, $command [, \@arguments ] )
199 Documented in L<Catalyst>
205 my ( $c, $command ) = @_;
206 my ( $action, $args ) = $self->_command2action(@_);
210 qq/Couldn't forward to command "$command": /
211 . qq/Invalid action or component./;
213 $c->log->debug($error) if $c->debug;
217 local $c->request->{arguments} = $args;
218 $action->dispatch( $c );
223 sub _action_rel2abs {
224 my ( $self, $c, $path ) = @_;
226 unless ( $path =~ m#^/# ) {
227 my $namespace = $c->stack->[-1]->namespace;
228 $path = "$namespace/$path";
235 sub _invoke_as_path {
236 my ( $self, $c, $rel_path, $args ) = @_;
238 my $path = $self->_action_rel2abs( $c, $rel_path );
240 my ( $tail, @extra_args );
241 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
242 { # allow $path to be empty
243 if ( my $action = $c->get_action( $tail, $path ) ) {
244 push @$args, @extra_args;
250 ; # if a match on the global namespace failed then the whole lookup failed
253 unshift @extra_args, $tail;
257 sub _find_component_class {
258 my ( $self, $c, $component ) = @_;
260 return ref($component)
261 || ref( $c->component($component) )
262 || $c->component($component);
265 sub _invoke_as_component {
266 my ( $self, $c, $component, $method ) = @_;
268 my $class = $self->_find_component_class( $c, $component ) || return 0;
270 if ( my $code = $class->can($method) ) {
271 return $self->method_action_class->new(
275 reverse => "$class->$method",
277 namespace => Catalyst::Utils::class2prefix(
278 $class, $c->config->{case_sensitive}
285 qq/Couldn't forward to "$class". Does not implement "$method"/;
287 $c->log->debug($error)
293 =head2 $self->prepare_action($c)
295 Find an dispatch type that matches $c->req->path, and set args from it.
300 my ( $self, $c ) = @_;
301 my $path = $c->req->path;
302 my @path = split /\//, $c->req->path;
303 $c->req->args( \my @args );
305 unshift( @path, '' ); # Root action
307 DESCEND: while (@path) {
308 $path = join '/', @path;
311 $path = '' if $path eq '/'; # Root action
313 # Check out dispatch types to see if any will handle the path at
316 foreach my $type ( @{ $self->dispatch_types } ) {
317 last DESCEND if $type->match( $c, $path );
320 # If not, move the last part path to args
321 my $arg = pop(@path);
322 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
326 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$c->req->captures||[]};
328 $c->log->debug( 'Path is "' . $c->req->match . '"' )
329 if ( $c->debug && length $c->req->match );
331 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
332 if ( $c->debug && @args );
335 =head2 $self->get_action( $action, $namespace )
337 returns a named action from a given namespace.
342 my ( $self, $name, $namespace ) = @_;
345 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
347 return $self->action_hash->{"$namespace/$name"};
350 =head2 $self->get_action_by_path( $path );
352 Returns the named action by its full path.
356 sub get_action_by_path {
357 my ( $self, $path ) = @_;
359 $path = "/$path" unless $path =~ /\//;
360 $self->action_hash->{$path};
363 =head2 $self->get_actions( $c, $action, $namespace )
368 my ( $self, $c, $action, $namespace ) = @_;
369 return [] unless $action;
371 $namespace = join( "/", grep { length } split '/', $namespace || "" );
373 my @match = $self->get_containers($namespace);
375 return map { $_->get_action($action) } @match;
378 =head2 $self->get_containers( $namespace )
380 Return all the action containers for a given namespace, inclusive
385 my ( $self, $namespace ) = @_;
387 $namespace = '' if $namespace eq '/';
391 if ( length $namespace ) {
393 push @containers, $self->container_hash->{$namespace};
394 } while ( $namespace =~ s#/[^/]+$## );
397 return reverse grep { defined } @containers, $self->container_hash->{''};
399 my @parts = split '/', $namespace;
402 =head2 $self->uri_for_action($action, \@captures)
404 Takes a Catalyst::Action object and action parameters and returns a URI
405 part such that if $c->req->path were this URI part, this action would be
406 dispatched to with $c->req->captures set to the supplied arrayref.
408 If the action object is not available for external dispatch or the dispatcher
409 cannot determine an appropriate URI, this method will return undef.
414 my ( $self, $action, $captures) = @_;
416 foreach my $dispatch_type ( @{ $self->dispatch_types } ) {
417 my $uri = $dispatch_type->uri_for_action( $action, $captures );
418 return( $uri eq '' ? '/' : $uri )
424 =head2 $self->register( $c, $action )
426 Make sure all required dispatch types for this action are loaded, then
427 pass the action to our dispatch types so they can register it if required.
428 Also, set up the tree with the action containers.
433 my ( $self, $c, $action ) = @_;
435 my $registered = $self->registered_dispatch_types;
438 foreach my $key ( keys %{ $action->attributes } ) {
439 next if $key eq 'Private';
440 my $class = "Catalyst::DispatchType::$key";
441 unless ( $registered->{$class} ) {
442 eval "require $class";
443 push( @{ $self->dispatch_types }, $class->new ) unless $@;
444 $registered->{$class} = 1;
448 # Pass the action to our dispatch types so they can register it if reqd.
449 foreach my $type ( @{ $self->dispatch_types } ) {
450 $type->register( $c, $action );
453 my $namespace = $action->namespace;
454 my $name = $action->name;
456 my $container = $self->_find_or_create_action_container($namespace);
458 # Set the method value
459 $container->add_action($action);
461 $self->action_hash->{"$namespace/$name"} = $action;
462 $self->container_hash->{$namespace} = $container;
465 sub _find_or_create_action_container {
466 my ( $self, $namespace ) = @_;
468 my $tree ||= $self->tree;
470 return $tree->getNodeValue unless $namespace;
472 my @namespace = split '/', $namespace;
473 return $self->_find_or_create_namespace_node( $tree, @namespace )
477 sub _find_or_create_namespace_node {
478 my ( $self, $parent, $part, @namespace ) = @_;
480 return $parent unless $part;
483 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
486 my $container = Catalyst::ActionContainer->new($part);
487 $parent->addChild( $child = Tree::Simple->new($container) );
490 $self->_find_or_create_namespace_node( $child, @namespace );
493 =head2 $self->setup_actions( $class, $context )
499 my ( $self, $c ) = @_;
501 $self->dispatch_types( [] );
502 $self->registered_dispatch_types( {} );
503 $self->method_action_class('Catalyst::Action');
504 $self->action_container_class('Catalyst::ActionContainer');
507 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
508 @{ $self->registered_dispatch_types }{@classes} = (1) x @classes;
510 foreach my $comp ( values %{ $c->components } ) {
511 $comp->register_actions($c) if $comp->can('register_actions');
514 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
516 return unless $c->debug;
518 my $privates = Text::SimpleTable->new(
526 my ( $walker, $parent, $prefix ) = @_;
527 $prefix .= $parent->getNodeValue || '';
528 $prefix .= '/' unless $prefix =~ /\/$/;
529 my $node = $parent->getNodeValue->actions;
531 for my $action ( keys %{$node} ) {
532 my $action_obj = $node->{$action};
534 if ( ( $action =~ /^_.*/ )
535 && ( !$c->config->{show_internal_actions} ) );
536 $privates->row( "$prefix$action", $action_obj->class, $action );
540 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
543 $walker->( $walker, $self->tree, '' );
544 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
547 # List all public actions
548 $_->list($c) for @{ $self->dispatch_types };
551 sub _load_dispatch_types {
552 my ( $self, @types ) = @_;
556 # Preload action types
557 for my $type (@types) {
559 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
560 eval "require $class";
561 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
563 push @{ $self->dispatch_types }, $class->new;
565 push @loaded, $class;
573 Catalyst Contributors, see Catalyst.pm
577 This program is free software, you can redistribute it and/or modify it under
578 the same terms as Perl itself.