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 local $c->request->{arguments} = $args;
182 $c->namespace($action->namespace);
189 =head2 $self->forward( $c, $command [, \@arguments ] )
191 Documented in L<Catalyst>
197 my ( $c, $command ) = @_;
198 my ( $action, $args ) = $self->_command2action(@_);
202 qq/Couldn't forward to command "$command": /
203 . qq/Invalid action or component./;
205 $c->log->debug($error) if $c->debug;
211 no warnings 'recursion';
213 my $orig_args = $c->request->arguments();
214 $c->request->arguments($args);
215 $action->dispatch( $c );
216 $c->request->arguments($orig_args);
221 sub _action_rel2abs {
222 my ( $self, $c, $path ) = @_;
224 unless ( $path =~ m#^/# ) {
225 my $namespace = $c->stack->[-1]->namespace;
226 $path = "$namespace/$path";
233 sub _invoke_as_path {
234 my ( $self, $c, $rel_path, $args ) = @_;
236 my $path = $self->_action_rel2abs( $c, $rel_path );
238 my ( $tail, @extra_args );
239 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
240 { # allow $path to be empty
241 if ( my $action = $c->get_action( $tail, $path ) ) {
242 push @$args, @extra_args;
248 ; # if a match on the global namespace failed then the whole lookup failed
251 unshift @extra_args, $tail;
255 sub _find_component_class {
256 my ( $self, $c, $component ) = @_;
258 return ref($component)
259 || ref( $c->component($component) )
260 || $c->component($component);
263 sub _invoke_as_component {
264 my ( $self, $c, $component, $method ) = @_;
266 my $class = $self->_find_component_class( $c, $component ) || return 0;
268 if ( my $code = $class->can($method) ) {
269 return $self->_method_action_class->new(
273 reverse => "$class->$method",
275 namespace => Catalyst::Utils::class2prefix(
276 $class, $c->config->{case_sensitive}
283 qq/Couldn't forward to "$class". Does not implement "$method"/;
285 $c->log->debug($error)
291 =head2 $self->prepare_action($c)
293 Find an dispatch type that matches $c->req->path, and set args from it.
298 my ( $self, $c ) = @_;
300 my $path = $req->path;
301 my @path = split /\//, $req->path;
302 $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 } @{$req->captures||[]};
327 $c->log->debug( 'Path is "' . $req->match . '"' )
328 if ( $c->debug && length $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 #return (split '/', $namespace); # isnt this more clear?
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;
437 #my $priv = 0; #seems to be unused
438 foreach my $key ( keys %{ $action->attributes } ) {
439 next if $key eq 'Private';
440 my $class = "Catalyst::DispatchType::$key";
441 unless ( $registered->{$class} ) {
442 #some error checking rethrowing here wouldn't hurt.
443 eval { Class::MOP::load_class($class) };
444 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
445 $registered->{$class} = 1;
449 # Pass the action to our dispatch types so they can register it if reqd.
450 foreach my $type ( @{ $self->_dispatch_types } ) {
451 $type->register( $c, $action );
454 my $namespace = $action->namespace;
455 my $name = $action->name;
457 my $container = $self->_find_or_create_action_container($namespace);
459 # Set the method value
460 $container->add_action($action);
462 $self->_action_hash->{"$namespace/$name"} = $action;
463 $self->_container_hash->{$namespace} = $container;
466 sub _find_or_create_action_container {
467 my ( $self, $namespace ) = @_;
469 my $tree ||= $self->_tree;
471 return $tree->getNodeValue unless $namespace;
473 my @namespace = split '/', $namespace;
474 return $self->_find_or_create_namespace_node( $tree, @namespace )
478 sub _find_or_create_namespace_node {
479 my ( $self, $parent, $part, @namespace ) = @_;
481 return $parent unless $part;
484 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
487 my $container = Catalyst::ActionContainer->new($part);
488 $parent->addChild( $child = Tree::Simple->new($container) );
491 $self->_find_or_create_namespace_node( $child, @namespace );
494 =head2 $self->setup_actions( $class, $context )
500 my ( $self, $c ) = @_;
504 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
505 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
507 foreach my $comp ( values %{ $c->components } ) {
508 $comp->register_actions($c) if $comp->can('register_actions');
511 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
513 return unless $c->debug;
515 my $privates = Text::SimpleTable->new(
523 my ( $walker, $parent, $prefix ) = @_;
524 $prefix .= $parent->getNodeValue || '';
525 $prefix .= '/' unless $prefix =~ /\/$/;
526 my $node = $parent->getNodeValue->actions;
528 for my $action ( keys %{$node} ) {
529 my $action_obj = $node->{$action};
531 if ( ( $action =~ /^_.*/ )
532 && ( !$c->config->{show_internal_actions} ) );
533 $privates->row( "$prefix$action", $action_obj->class, $action );
537 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
540 $walker->( $walker, $self->_tree, '' );
541 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
544 # List all public actions
545 $_->list($c) for @{ $self->_dispatch_types };
548 sub _load_dispatch_types {
549 my ( $self, @types ) = @_;
553 # Preload action types
554 for my $type (@types) {
556 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
558 eval { Class::MOP::load_class($class) };
559 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
561 push @{ $self->_dispatch_types }, $class->new;
563 push @loaded, $class;
570 __PACKAGE__->meta->make_immutable;
578 Catalyst Contributors, see Catalyst.pm
582 This program is free software, you can redistribute it and/or modify it under
583 the same terms as Perl itself.