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->visit( $c, $command [, \@arguments ] )
163 Documented in L<Catalyst>
169 $self->_do_visit('visit', @_);
175 my ( $c, $command ) = @_;
176 my ( $action, $args ) = $self->_command2action(@_);
177 my $error = qq/Couldn't $opname("$command"): /;
180 $error .= qq/Invalid action or component./;
182 elsif (!defined $action->namespace) {
183 $error .= qq/Action has no namespace: cannot $opname() to a plain /
184 .qq/method or component, must be a :Action or some sort./
186 elsif (!$action->class->can('_DISPATCH')) {
187 $error .= qq/Action cannot _DISPATCH. /
188 .qq/Did you try to $opname() a non-controller action?/;
196 $c->log->debug($error) if $c->debug;
200 $action = $self->expand_action($action);
202 local $c->request->{arguments} = $args;
203 local $c->{namespace} = $action->{'namespace'};
204 local $c->{action} = $action;
209 =head2 $self->go( $c, $command [, \@arguments ] )
211 Documented in L<Catalyst>
217 $self->_do_visit('go', @_);
221 =head2 $self->forward( $c, $command [, \@arguments ] )
223 Documented in L<Catalyst>
229 my ( $c, $command ) = @_;
230 my ( $action, $args ) = $self->_command2action(@_);
234 qq/Couldn't forward to command "$command": /
235 . qq/Invalid action or component./;
237 $c->log->debug($error) if $c->debug;
243 no warnings 'recursion';
245 my $orig_args = $c->request->arguments();
246 $c->request->arguments($args);
247 $action->dispatch( $c );
248 $c->request->arguments($orig_args);
253 sub _action_rel2abs {
254 my ( $self, $c, $path ) = @_;
256 unless ( $path =~ m#^/# ) {
257 my $namespace = $c->stack->[-1]->namespace;
258 $path = "$namespace/$path";
265 sub _invoke_as_path {
266 my ( $self, $c, $rel_path, $args ) = @_;
268 my $path = $self->_action_rel2abs( $c, $rel_path );
270 my ( $tail, @extra_args );
271 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
272 { # allow $path to be empty
273 if ( my $action = $c->get_action( $tail, $path ) ) {
274 push @$args, @extra_args;
280 ; # if a match on the global namespace failed then the whole lookup failed
283 unshift @extra_args, $tail;
287 sub _find_component_class {
288 my ( $self, $c, $component ) = @_;
290 return ref($component)
291 || ref( $c->component($component) )
292 || $c->component($component);
295 sub _invoke_as_component {
296 my ( $self, $c, $component, $method ) = @_;
298 my $class = $self->_find_component_class( $c, $component ) || return 0;
300 if ( my $code = $class->can($method) ) {
301 return $self->_method_action_class->new(
305 reverse => "$class->$method",
307 namespace => Catalyst::Utils::class2prefix(
308 $class, $c->config->{case_sensitive}
315 qq/Couldn't forward to "$class". Does not implement "$method"/;
317 $c->log->debug($error)
323 =head2 $self->prepare_action($c)
325 Find an dispatch type that matches $c->req->path, and set args from it.
330 my ( $self, $c ) = @_;
332 my $path = $req->path;
333 my @path = split /\//, $req->path;
334 $req->args( \my @args );
336 unshift( @path, '' ); # Root action
338 DESCEND: while (@path) {
339 $path = join '/', @path;
342 $path = '' if $path eq '/'; # Root action
344 # Check out dispatch types to see if any will handle the path at
347 foreach my $type ( @{ $self->_dispatch_types } ) {
348 last DESCEND if $type->match( $c, $path );
351 # If not, move the last part path to args
352 my $arg = pop(@path);
353 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
357 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
359 $c->log->debug( 'Path is "' . $req->match . '"' )
360 if ( $c->debug && length $req->match );
362 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
363 if ( $c->debug && @args );
366 =head2 $self->get_action( $action, $namespace )
368 returns a named action from a given namespace.
373 my ( $self, $name, $namespace ) = @_;
376 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
378 return $self->_action_hash->{"${namespace}/${name}"};
381 =head2 $self->get_action_by_path( $path );
383 Returns the named action by its full path.
387 sub get_action_by_path {
388 my ( $self, $path ) = @_;
390 $path = "/$path" unless $path =~ /\//;
391 $self->_action_hash->{$path};
394 =head2 $self->get_actions( $c, $action, $namespace )
399 my ( $self, $c, $action, $namespace ) = @_;
400 return [] unless $action;
402 $namespace = join( "/", grep { length } split '/', $namespace || "" );
404 my @match = $self->get_containers($namespace);
406 return map { $_->get_action($action) } @match;
409 =head2 $self->get_containers( $namespace )
411 Return all the action containers for a given namespace, inclusive
416 my ( $self, $namespace ) = @_;
418 $namespace = '' if $namespace eq '/';
422 if ( length $namespace ) {
424 push @containers, $self->_container_hash->{$namespace};
425 } while ( $namespace =~ s#/[^/]+$## );
428 return reverse grep { defined } @containers, $self->_container_hash->{''};
430 #return (split '/', $namespace); # isnt this more clear?
431 my @parts = split '/', $namespace;
434 =head2 $self->uri_for_action($action, \@captures)
436 Takes a Catalyst::Action object and action parameters and returns a URI
437 part such that if $c->req->path were this URI part, this action would be
438 dispatched to with $c->req->captures set to the supplied arrayref.
440 If the action object is not available for external dispatch or the dispatcher
441 cannot determine an appropriate URI, this method will return undef.
446 my ( $self, $action, $captures) = @_;
448 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
449 my $uri = $dispatch_type->uri_for_action( $action, $captures );
450 return( $uri eq '' ? '/' : $uri )
458 expand an action into a full representation of the dispatch.
459 mostly useful for chained, other actions will just return a
465 my ($self, $action) = @_;
467 foreach my $dispatch_type (@{ $self->_dispatch_types }) {
468 my $expanded = $dispatch_type->expand_action($action);
469 return $expanded if $expanded;
475 =head2 $self->register( $c, $action )
477 Make sure all required dispatch types for this action are loaded, then
478 pass the action to our dispatch types so they can register it if required.
479 Also, set up the tree with the action containers.
484 my ( $self, $c, $action ) = @_;
486 my $registered = $self->_registered_dispatch_types;
488 #my $priv = 0; #seems to be unused
489 foreach my $key ( keys %{ $action->attributes } ) {
490 next if $key eq 'Private';
491 my $class = "Catalyst::DispatchType::$key";
492 unless ( $registered->{$class} ) {
493 #some error checking rethrowing here wouldn't hurt.
494 eval { Class::MOP::load_class($class) };
495 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
496 $registered->{$class} = 1;
500 # Pass the action to our dispatch types so they can register it if reqd.
501 foreach my $type ( @{ $self->_dispatch_types } ) {
502 $type->register( $c, $action );
505 my $namespace = $action->namespace;
506 my $name = $action->name;
508 my $container = $self->_find_or_create_action_container($namespace);
510 # Set the method value
511 $container->add_action($action);
513 $self->_action_hash->{"$namespace/$name"} = $action;
514 $self->_container_hash->{$namespace} = $container;
517 sub _find_or_create_action_container {
518 my ( $self, $namespace ) = @_;
520 my $tree ||= $self->_tree;
522 return $tree->getNodeValue unless $namespace;
524 my @namespace = split '/', $namespace;
525 return $self->_find_or_create_namespace_node( $tree, @namespace )
529 sub _find_or_create_namespace_node {
530 my ( $self, $parent, $part, @namespace ) = @_;
532 return $parent unless $part;
535 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
538 my $container = Catalyst::ActionContainer->new($part);
539 $parent->addChild( $child = Tree::Simple->new($container) );
542 $self->_find_or_create_namespace_node( $child, @namespace );
545 =head2 $self->setup_actions( $class, $context )
551 my ( $self, $c ) = @_;
555 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
556 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
558 foreach my $comp ( values %{ $c->components } ) {
559 $comp->register_actions($c) if $comp->can('register_actions');
562 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
564 return unless $c->debug;
566 my $privates = Text::SimpleTable->new(
574 my ( $walker, $parent, $prefix ) = @_;
575 $prefix .= $parent->getNodeValue || '';
576 $prefix .= '/' unless $prefix =~ /\/$/;
577 my $node = $parent->getNodeValue->actions;
579 for my $action ( keys %{$node} ) {
580 my $action_obj = $node->{$action};
582 if ( ( $action =~ /^_.*/ )
583 && ( !$c->config->{show_internal_actions} ) );
584 $privates->row( "$prefix$action", $action_obj->class, $action );
588 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
591 $walker->( $walker, $self->_tree, '' );
592 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
595 # List all public actions
596 $_->list($c) for @{ $self->_dispatch_types };
599 sub _load_dispatch_types {
600 my ( $self, @types ) = @_;
604 # Preload action types
605 for my $type (@types) {
607 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
609 eval { Class::MOP::load_class($class) };
610 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
612 push @{ $self->_dispatch_types }, $class->new;
614 push @loaded, $class;
621 __PACKAGE__->meta->make_immutable;
629 Catalyst Contributors, see Catalyst.pm
633 This program is free software, you can redistribute it and/or modify it under
634 the same terms as Perl itself.