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 # $self->_command2action( $c, $command [, \@arguments ] )
124 # Search for an action, from the command and returns C<($action, $args)> on
125 # success. Returns C<(0)> on error.
127 sub _command2action {
128 my ( $self, $c, $command, @extra_params ) = @_;
131 $c->log->debug('Nothing to go to') if $c->debug;
137 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
138 @args = @{ pop @extra_params }
140 # this is a copy, it may take some abuse from
141 # ->_invoke_as_path if the path had trailing parts
142 @args = @{ $c->request->arguments };
147 # go to a string path ("/foo/bar/gorch")
148 # or action object which stringifies to that
149 $action = $self->_invoke_as_path( $c, "$command", \@args );
151 # go to a component ( "MyApp::*::Foo" or $c->component("...")
152 # - a path or an object)
154 my $method = @extra_params ? $extra_params[0] : "process";
155 $action = $self->_invoke_as_component( $c, $command, $method );
158 return $action, \@args;
161 =head2 $self->go( $c, $command [, \@arguments ] )
163 Documented in L<Catalyst>
169 my ( $c, $command ) = @_;
170 my ( $action, $args ) = $self->_command2action(@_);
172 unless ($action && defined $action->namespace) {
174 qq/Couldn't go to command "$command": /
175 . qq/Invalid action or component./;
177 $c->log->debug($error) if $c->debug;
181 $action = $self->expand_action($action);
183 local $c->request->{arguments} = $args;
184 $c->namespace($action->namespace);
191 =head2 $self->forward( $c, $command [, \@arguments ] )
193 Documented in L<Catalyst>
199 my ( $c, $command ) = @_;
200 my ( $action, $args ) = $self->_command2action(@_);
204 qq/Couldn't forward to command "$command": /
205 . qq/Invalid action or component./;
207 $c->log->debug($error) if $c->debug;
213 no warnings 'recursion';
215 my $orig_args = $c->request->arguments();
216 $c->request->arguments($args);
217 $action->dispatch( $c );
218 $c->request->arguments($orig_args);
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 ) = @_;
302 my $path = $req->path;
303 my @path = split /\//, $req->path;
304 $req->args( \my @args );
306 unshift( @path, '' ); # Root action
308 DESCEND: while (@path) {
309 $path = join '/', @path;
312 $path = '' if $path eq '/'; # Root action
314 # Check out dispatch types to see if any will handle the path at
317 foreach my $type ( @{ $self->_dispatch_types } ) {
318 last DESCEND if $type->match( $c, $path );
321 # If not, move the last part path to args
322 my $arg = pop(@path);
323 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
327 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
329 $c->log->debug( 'Path is "' . $req->match . '"' )
330 if ( $c->debug && length $req->match );
332 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
333 if ( $c->debug && @args );
336 =head2 $self->get_action( $action, $namespace )
338 returns a named action from a given namespace.
343 my ( $self, $name, $namespace ) = @_;
346 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
348 return $self->_action_hash->{"${namespace}/${name}"};
351 =head2 $self->get_action_by_path( $path );
353 Returns the named action by its full path.
357 sub get_action_by_path {
358 my ( $self, $path ) = @_;
360 $path = "/$path" unless $path =~ /\//;
361 $self->_action_hash->{$path};
364 =head2 $self->get_actions( $c, $action, $namespace )
369 my ( $self, $c, $action, $namespace ) = @_;
370 return [] unless $action;
372 $namespace = join( "/", grep { length } split '/', $namespace || "" );
374 my @match = $self->get_containers($namespace);
376 return map { $_->get_action($action) } @match;
379 =head2 $self->get_containers( $namespace )
381 Return all the action containers for a given namespace, inclusive
386 my ( $self, $namespace ) = @_;
388 $namespace = '' if $namespace eq '/';
392 if ( length $namespace ) {
394 push @containers, $self->_container_hash->{$namespace};
395 } while ( $namespace =~ s#/[^/]+$## );
398 return reverse grep { defined } @containers, $self->_container_hash->{''};
400 #return (split '/', $namespace); # isnt this more clear?
401 my @parts = split '/', $namespace;
404 =head2 $self->uri_for_action($action, \@captures)
406 Takes a Catalyst::Action object and action parameters and returns a URI
407 part such that if $c->req->path were this URI part, this action would be
408 dispatched to with $c->req->captures set to the supplied arrayref.
410 If the action object is not available for external dispatch or the dispatcher
411 cannot determine an appropriate URI, this method will return undef.
416 my ( $self, $action, $captures) = @_;
418 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
419 my $uri = $dispatch_type->uri_for_action( $action, $captures );
420 return( $uri eq '' ? '/' : $uri )
427 my ($self, $action) = @_;
429 foreach my $dispatch_type (@{ $self->_dispatch_types }) {
430 my $expanded = $dispatch_type->expand_action($action);
431 return $expanded if $expanded;
437 =head2 $self->register( $c, $action )
439 Make sure all required dispatch types for this action are loaded, then
440 pass the action to our dispatch types so they can register it if required.
441 Also, set up the tree with the action containers.
446 my ( $self, $c, $action ) = @_;
448 my $registered = $self->_registered_dispatch_types;
450 #my $priv = 0; #seems to be unused
451 foreach my $key ( keys %{ $action->attributes } ) {
452 next if $key eq 'Private';
453 my $class = "Catalyst::DispatchType::$key";
454 unless ( $registered->{$class} ) {
455 #some error checking rethrowing here wouldn't hurt.
456 eval { Class::MOP::load_class($class) };
457 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
458 $registered->{$class} = 1;
462 # Pass the action to our dispatch types so they can register it if reqd.
463 foreach my $type ( @{ $self->_dispatch_types } ) {
464 $type->register( $c, $action );
467 my $namespace = $action->namespace;
468 my $name = $action->name;
470 my $container = $self->_find_or_create_action_container($namespace);
472 # Set the method value
473 $container->add_action($action);
475 $self->_action_hash->{"$namespace/$name"} = $action;
476 $self->_container_hash->{$namespace} = $container;
479 sub _find_or_create_action_container {
480 my ( $self, $namespace ) = @_;
482 my $tree ||= $self->_tree;
484 return $tree->getNodeValue unless $namespace;
486 my @namespace = split '/', $namespace;
487 return $self->_find_or_create_namespace_node( $tree, @namespace )
491 sub _find_or_create_namespace_node {
492 my ( $self, $parent, $part, @namespace ) = @_;
494 return $parent unless $part;
497 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
500 my $container = Catalyst::ActionContainer->new($part);
501 $parent->addChild( $child = Tree::Simple->new($container) );
504 $self->_find_or_create_namespace_node( $child, @namespace );
507 =head2 $self->setup_actions( $class, $context )
513 my ( $self, $c ) = @_;
517 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
518 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
520 foreach my $comp ( values %{ $c->components } ) {
521 $comp->register_actions($c) if $comp->can('register_actions');
524 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
526 return unless $c->debug;
528 my $privates = Text::SimpleTable->new(
536 my ( $walker, $parent, $prefix ) = @_;
537 $prefix .= $parent->getNodeValue || '';
538 $prefix .= '/' unless $prefix =~ /\/$/;
539 my $node = $parent->getNodeValue->actions;
541 for my $action ( keys %{$node} ) {
542 my $action_obj = $node->{$action};
544 if ( ( $action =~ /^_.*/ )
545 && ( !$c->config->{show_internal_actions} ) );
546 $privates->row( "$prefix$action", $action_obj->class, $action );
550 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
553 $walker->( $walker, $self->_tree, '' );
554 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
557 # List all public actions
558 $_->list($c) for @{ $self->_dispatch_types };
561 sub _load_dispatch_types {
562 my ( $self, @types ) = @_;
566 # Preload action types
567 for my $type (@types) {
569 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
571 eval { Class::MOP::load_class($class) };
572 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
574 push @{ $self->_dispatch_types }, $class->new;
576 push @loaded, $class;
583 __PACKAGE__->meta->make_immutable;
591 Catalyst Contributors, see Catalyst.pm
595 This program is free software, you can redistribute it and/or modify it under
596 the same terms as Perl itself.