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->dispatch($c)
89 Delegate the dispatch to the action that matched the url, or return a
90 message about unknown resource
96 my ( $self, $c ) = @_;
97 if ( my $action = $c->action ) {
98 $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
102 my $path = $c->req->path;
104 ? qq/Unknown resource "$path"/
105 : "No default action defined";
106 $c->log->error($error) if $c->debug;
111 # $self->_command2action( $c, $command [, \@arguments ] )
112 # Search for an action, from the command and returns C<($action, $args)> on
113 # success. Returns C<(0)> on error.
115 sub _command2action {
116 my ( $self, $c, $command, @extra_params ) = @_;
119 $c->log->debug('Nothing to go to') if $c->debug;
125 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
126 @args = @{ pop @extra_params }
128 # this is a copy, it may take some abuse from
129 # ->_invoke_as_path if the path had trailing parts
130 @args = @{ $c->request->arguments };
135 # go to a string path ("/foo/bar/gorch")
137 if (Scalar::Util::blessed($command) && $command->isa('Catalyst::Action')) {
141 $action = $self->_invoke_as_path( $c, "$command", \@args );
144 # go to a component ( "MyApp::*::Foo" or $c->component("...")
145 # - a path or an object)
147 my $method = @extra_params ? $extra_params[0] : "process";
148 $action = $self->_invoke_as_component( $c, $command, $method );
151 return $action, \@args;
154 =head2 $self->visit( $c, $command [, \@arguments ] )
156 Documented in L<Catalyst>
162 $self->_do_visit('visit', @_);
168 my ( $c, $command ) = @_;
169 my ( $action, $args ) = $self->_command2action(@_);
170 my $error = qq/Couldn't $opname("$command"): /;
173 $error .= qq/Couldn't $opname to command "$command": /
174 .qq/Invalid action or component./;
176 elsif (!defined $action->namespace) {
177 $error .= qq/Action has no namespace: cannot $opname() to a plain /
178 .qq/method or component, must be a :Action or some sort./
180 elsif (!$action->class->can('_DISPATCH')) {
181 $error .= qq/Action cannot _DISPATCH. /
182 .qq/Did you try to $opname() a non-controller action?/;
190 $c->log->debug($error) if $c->debug;
194 $action = $self->expand_action($action);
196 local $c->request->{arguments} = $args;
197 local $c->{namespace} = $action->{'namespace'};
198 local $c->{action} = $action;
203 =head2 $self->go( $c, $command [, \@arguments ] )
205 Documented in L<Catalyst>
211 $self->_do_visit('go', @_);
215 =head2 $self->forward( $c, $command [, \@arguments ] )
217 Documented in L<Catalyst>
223 $self->_do_forward(forward => @_);
229 my ( $c, $command ) = @_;
230 my ( $action, $args ) = $self->_command2action(@_);
233 my $error .= qq/Couldn't $opname to command "$command": /
234 .qq/Invalid action or component./;
236 $c->log->debug($error) if $c->debug;
240 no warnings 'recursion';
242 my $orig_args = $c->request->arguments();
243 $c->request->arguments($args);
244 $action->dispatch( $c );
245 $c->request->arguments($orig_args);
250 =head2 $self->detach( $c, $command [, \@arguments ] )
252 Documented in L<Catalyst>
257 my ( $self, $c, $command, @args ) = @_;
258 $self->_do_forward(detach => $c, $command, @args ) if $command;
259 die $Catalyst::DETACH;
262 sub _action_rel2abs {
263 my ( $self, $c, $path ) = @_;
265 unless ( $path =~ m#^/# ) {
266 my $namespace = $c->stack->[-1]->namespace;
267 $path = "$namespace/$path";
274 sub _invoke_as_path {
275 my ( $self, $c, $rel_path, $args ) = @_;
277 my $path = $self->_action_rel2abs( $c, $rel_path );
279 my ( $tail, @extra_args );
280 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
281 { # allow $path to be empty
282 if ( my $action = $c->get_action( $tail, $path ) ) {
283 push @$args, @extra_args;
289 ; # if a match on the global namespace failed then the whole lookup failed
292 unshift @extra_args, $tail;
296 sub _find_component_class {
297 my ( $self, $c, $component ) = @_;
299 return ref($component)
300 || ref( $c->component($component) )
301 || $c->component($component);
304 sub _invoke_as_component {
305 my ( $self, $c, $component, $method ) = @_;
307 my $class = $self->_find_component_class( $c, $component ) || return 0;
309 if ( my $code = $class->can($method) ) {
310 return $self->_method_action_class->new(
314 reverse => "$class->$method",
316 namespace => Catalyst::Utils::class2prefix(
317 $class, $c->config->{case_sensitive}
324 qq/Couldn't forward to "$class". Does not implement "$method"/;
326 $c->log->debug($error)
332 =head2 $self->prepare_action($c)
334 Find an dispatch type that matches $c->req->path, and set args from it.
339 my ( $self, $c ) = @_;
341 my $path = $req->path;
342 my @path = split /\//, $req->path;
343 $req->args( \my @args );
345 unshift( @path, '' ); # Root action
347 DESCEND: while (@path) {
348 $path = join '/', @path;
351 $path = '' if $path eq '/'; # Root action
353 # Check out dispatch types to see if any will handle the path at
356 foreach my $type ( @{ $self->_dispatch_types } ) {
357 last DESCEND if $type->match( $c, $path );
360 # If not, move the last part path to args
361 my $arg = pop(@path);
362 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
366 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
368 $c->log->debug( 'Path is "' . $req->match . '"' )
369 if ( $c->debug && defined $req->match && length $req->match );
371 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
372 if ( $c->debug && @args );
375 =head2 $self->get_action( $action, $namespace )
377 returns a named action from a given namespace.
382 my ( $self, $name, $namespace ) = @_;
385 $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) );
387 return $self->_action_hash->{"${namespace}/${name}"};
390 =head2 $self->get_action_by_path( $path );
392 Returns the named action by its full path.
396 sub get_action_by_path {
397 my ( $self, $path ) = @_;
399 $path = "/$path" unless $path =~ /\//;
400 $self->_action_hash->{$path};
403 =head2 $self->get_actions( $c, $action, $namespace )
408 my ( $self, $c, $action, $namespace ) = @_;
409 return [] unless $action;
411 $namespace = join( "/", grep { length } split '/', $namespace || "" );
413 my @match = $self->get_containers($namespace);
415 return map { $_->get_action($action) } @match;
418 =head2 $self->get_containers( $namespace )
420 Return all the action containers for a given namespace, inclusive
425 my ( $self, $namespace ) = @_;
427 $namespace = '' if $namespace eq '/';
431 if ( length $namespace ) {
433 push @containers, $self->_container_hash->{$namespace};
434 } while ( $namespace =~ s#/[^/]+$## );
437 return reverse grep { defined } @containers, $self->_container_hash->{''};
439 #return (split '/', $namespace); # isnt this more clear?
440 my @parts = split '/', $namespace;
443 =head2 $self->uri_for_action($action, \@captures)
445 Takes a Catalyst::Action object and action parameters and returns a URI
446 part such that if $c->req->path were this URI part, this action would be
447 dispatched to with $c->req->captures set to the supplied arrayref.
449 If the action object is not available for external dispatch or the dispatcher
450 cannot determine an appropriate URI, this method will return undef.
455 my ( $self, $action, $captures) = @_;
457 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
458 my $uri = $dispatch_type->uri_for_action( $action, $captures );
459 return( $uri eq '' ? '/' : $uri )
467 expand an action into a full representation of the dispatch.
468 mostly useful for chained, other actions will just return a
474 my ($self, $action) = @_;
476 foreach my $dispatch_type (@{ $self->_dispatch_types }) {
477 my $expanded = $dispatch_type->expand_action($action);
478 return $expanded if $expanded;
484 =head2 $self->register( $c, $action )
486 Make sure all required dispatch types for this action are loaded, then
487 pass the action to our dispatch types so they can register it if required.
488 Also, set up the tree with the action containers.
493 my ( $self, $c, $action ) = @_;
495 my $registered = $self->_registered_dispatch_types;
497 #my $priv = 0; #seems to be unused
498 foreach my $key ( keys %{ $action->attributes } ) {
499 next if $key eq 'Private';
500 my $class = "Catalyst::DispatchType::$key";
501 unless ( $registered->{$class} ) {
502 #some error checking rethrowing here wouldn't hurt.
503 eval { Class::MOP::load_class($class) };
504 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
505 $registered->{$class} = 1;
509 # Pass the action to our dispatch types so they can register it if reqd.
510 foreach my $type ( @{ $self->_dispatch_types } ) {
511 $type->register( $c, $action );
514 my $namespace = $action->namespace;
515 my $name = $action->name;
517 my $container = $self->_find_or_create_action_container($namespace);
519 # Set the method value
520 $container->add_action($action);
522 $self->_action_hash->{"$namespace/$name"} = $action;
523 $self->_container_hash->{$namespace} = $container;
526 sub _find_or_create_action_container {
527 my ( $self, $namespace ) = @_;
529 my $tree ||= $self->_tree;
531 return $tree->getNodeValue unless $namespace;
533 my @namespace = split '/', $namespace;
534 return $self->_find_or_create_namespace_node( $tree, @namespace )
538 sub _find_or_create_namespace_node {
539 my ( $self, $parent, $part, @namespace ) = @_;
541 return $parent unless $part;
544 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
547 my $container = Catalyst::ActionContainer->new($part);
548 $parent->addChild( $child = Tree::Simple->new($container) );
551 $self->_find_or_create_namespace_node( $child, @namespace );
554 =head2 $self->setup_actions( $class, $context )
560 my ( $self, $c ) = @_;
564 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
565 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
567 foreach my $comp ( values %{ $c->components } ) {
568 $comp->register_actions($c) if $comp->can('register_actions');
571 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
573 return unless $c->debug;
575 my $privates = Text::SimpleTable->new(
583 my ( $walker, $parent, $prefix ) = @_;
584 $prefix .= $parent->getNodeValue || '';
585 $prefix .= '/' unless $prefix =~ /\/$/;
586 my $node = $parent->getNodeValue->actions;
588 for my $action ( keys %{$node} ) {
589 my $action_obj = $node->{$action};
591 if ( ( $action =~ /^_.*/ )
592 && ( !$c->config->{show_internal_actions} ) );
593 $privates->row( "$prefix$action", $action_obj->class, $action );
597 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
600 $walker->( $walker, $self->_tree, '' );
601 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
604 # List all public actions
605 $_->list($c) for @{ $self->_dispatch_types };
608 sub _load_dispatch_types {
609 my ( $self, @types ) = @_;
613 # Preload action types
614 for my $type (@types) {
616 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
618 eval { Class::MOP::load_class($class) };
619 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
621 push @{ $self->_dispatch_types }, $class->new;
623 push @loaded, $class;
630 __PACKAGE__->meta->make_immutable;
638 Catalyst Contributors, see Catalyst.pm
642 This program is free software, you can redistribute it and/or modify it under
643 the same terms as Perl itself.