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;
18 use overload '""' => sub { return ref(shift) }, fallback => 1;
21 #do these belong as package vars or should we build these via a builder method?
22 # Preload these action types
23 our @PRELOAD = qw/Index Path Regex/;
25 # Postload these action types
26 our @POSTLOAD = qw/Default/;
28 has _tree => (is => 'rw');
29 has _dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
30 has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
31 has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
32 has _action_container_class => (is => 'rw', default => 'Catalyst::ActionContainer');
34 has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
35 has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
36 has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
37 has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
43 Catalyst::Dispatcher - The Catalyst Dispatcher
51 This is the class that maps public urls to actions in your Catalyst
52 application based on the attributes you set.
58 Construct a new dispatcher.
63 my ($self, $params) = @_;
66 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
68 $self->_tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
71 =head2 $self->preload_dispatch_types
73 An arrayref of pre-loaded dispatchtype classes
75 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
76 To use a custom class outside the regular C<Catalyst> namespace, prefix
77 it with a C<+>, like so:
81 =head2 $self->postload_dispatch_types
83 An arrayref of post-loaded dispatchtype classes
85 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
86 To use a custom class outside the regular C<Catalyst> namespace, prefix
87 it with a C<+>, like so:
91 =head2 $self->detach( $c, $command [, \@arguments ] )
93 Documented in L<Catalyst>
98 my ( $self, $c, $command, @args ) = @_;
99 $c->forward( $command, @args ) if $command;
100 die $Catalyst::DETACH;
103 =head2 $self->dispatch($c)
105 Delegate the dispatch to the action that matched the url, or return a
106 message about unknown resource
112 my ( $self, $c ) = @_;
113 if ( my $action = $c->action ) {
114 $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) );
118 my $path = $c->req->path;
120 ? qq/Unknown resource "$path"/
121 : "No default action defined";
122 $c->log->error($error) if $c->debug;
127 =head2 $self->forward( $c, $command [, \@arguments ] )
129 Documented in L<Catalyst>
134 my ( $self, $c, $command, @extra_params ) = @_;
137 $c->log->debug('Nothing to forward to') if $c->debug;
143 if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
144 @args = @{ pop @extra_params }
146 # this is a copy, it may take some abuse from ->_invoke_as_path if the path had trailing parts
147 @args = @{ $c->request->arguments };
152 # forward to a string path ("/foo/bar/gorch") or action object which stringifies to that
153 $action = $self->_invoke_as_path( $c, "$command", \@args );
155 # forward to a component ( "MyApp::*::Foo" or $c->component("...") - a path or an object)
157 my $method = @extra_params ? $extra_params[0] : "process";
158 $action = $self->_invoke_as_component( $c, $command, $method );
164 qq/Couldn't forward to command "$command": /
165 . qq/Invalid action or component./;
167 $c->log->debug($error) if $c->debug;
173 no warnings 'recursion';
175 my $orig_args = $c->request->arguments();
176 $c->request->arguments(\@args);
177 $action->dispatch( $c );
178 $c->request->arguments($orig_args);
183 sub _action_rel2abs {
184 my ( $self, $c, $path ) = @_;
186 unless ( $path =~ m#^/# ) {
187 my $namespace = $c->stack->[-1]->namespace;
188 $path = "$namespace/$path";
195 sub _invoke_as_path {
196 my ( $self, $c, $rel_path, $args ) = @_;
198 my $path = $self->_action_rel2abs( $c, $rel_path );
200 my ( $tail, @extra_args );
201 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
202 { # allow $path to be empty
203 if ( my $action = $c->get_action( $tail, $path ) ) {
204 push @$args, @extra_args;
210 ; # if a match on the global namespace failed then the whole lookup failed
213 unshift @extra_args, $tail;
217 sub _find_component_class {
218 my ( $self, $c, $component ) = @_;
220 return ref($component)
221 || ref( $c->component($component) )
222 || $c->component($component);
225 sub _invoke_as_component {
226 my ( $self, $c, $component, $method ) = @_;
228 my $class = $self->_find_component_class( $c, $component ) || return 0;
230 if ( my $code = $class->can($method) ) {
231 return $self->_method_action_class->new(
235 reverse => "$class->$method",
237 namespace => Catalyst::Utils::class2prefix(
238 $class, $c->config->{case_sensitive}
245 qq/Couldn't forward to "$class". Does not implement "$method"/;
247 $c->log->debug($error)
253 =head2 $self->prepare_action($c)
255 Find an dispatch type that matches $c->req->path, and set args from it.
260 my ( $self, $c ) = @_;
262 my $path = $req->path;
263 my @path = split /\//, $req->path;
264 $req->args( \my @args );
266 unshift( @path, '' ); # Root action
268 DESCEND: while (@path) {
269 $path = join '/', @path;
272 $path = '' if $path eq '/'; # Root action
274 # Check out dispatch types to see if any will handle the path at
277 foreach my $type ( @{ $self->_dispatch_types } ) {
278 last DESCEND if $type->match( $c, $path );
281 # If not, move the last part path to args
282 my $arg = pop(@path);
283 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
287 s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
289 $c->log->debug( 'Path is "' . $req->match . '"' )
290 if ( $c->debug && $req->match );
292 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
293 if ( $c->debug && @args );
296 =head2 $self->get_action( $action, $namespace )
298 returns a named action from a given namespace.
303 my ( $self, $name, $namespace ) = @_;
306 $namespace = join( "/", grep { length } split '/', $namespace || "" );
308 return $self->_action_hash->{"${namespace}/${name}"};
311 =head2 $self->get_action_by_path( $path );
313 Returns the named action by its full path.
317 sub get_action_by_path {
318 my ( $self, $path ) = @_;
320 $path = "/$path" unless $path =~ /\//;
321 $self->_action_hash->{$path};
324 =head2 $self->get_actions( $c, $action, $namespace )
329 my ( $self, $c, $action, $namespace ) = @_;
330 return [] unless $action;
332 $namespace = join( "/", grep { length } split '/', $namespace || "" );
334 my @match = $self->get_containers($namespace);
336 return map { $_->get_action($action) } @match;
339 =head2 $self->get_containers( $namespace )
341 Return all the action containers for a given namespace, inclusive
346 my ( $self, $namespace ) = @_;
348 $namespace = '' if $namespace eq '/';
352 if ( length $namespace ) {
354 push @containers, $self->_container_hash->{$namespace};
355 } while ( $namespace =~ s#/[^/]+$## );
358 return reverse grep { defined } @containers, $self->_container_hash->{''};
360 #return (split '/', $namespace); # isnt this more clear?
361 my @parts = split '/', $namespace;
364 =head2 $self->uri_for_action($action, \@captures)
366 Takes a Catalyst::Action object and action parameters and returns a URI
367 part such that if $c->req->path were this URI part, this action would be
368 dispatched to with $c->req->captures set to the supplied arrayref.
370 If the action object is not available for external dispatch or the dispatcher
371 cannot determine an appropriate URI, this method will return undef.
376 my ( $self, $action, $captures) = @_;
378 foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
379 my $uri = $dispatch_type->uri_for_action( $action, $captures );
380 return( $uri eq '' ? '/' : $uri )
386 =head2 $self->register( $c, $action )
388 Make sure all required dispatch types for this action are loaded, then
389 pass the action to our dispatch types so they can register it if required.
390 Also, set up the tree with the action containers.
395 my ( $self, $c, $action ) = @_;
397 my $registered = $self->_registered_dispatch_types;
399 #my $priv = 0; #seems to be unused
400 foreach my $key ( keys %{ $action->attributes } ) {
401 next if $key eq 'Private';
402 my $class = "Catalyst::DispatchType::$key";
403 unless ( $registered->{$class} ) {
404 #some error checking rethrowing here wouldn't hurt.
405 eval { Class::MOP::load_class($class) };
406 push( @{ $self->_dispatch_types }, $class->new ) unless $@;
407 $registered->{$class} = 1;
411 # Pass the action to our dispatch types so they can register it if reqd.
412 foreach my $type ( @{ $self->_dispatch_types } ) {
413 $type->register( $c, $action );
416 my $namespace = $action->namespace;
417 my $name = $action->name;
419 my $container = $self->_find_or_create_action_container($namespace);
421 # Set the method value
422 $container->add_action($action);
424 $self->_action_hash->{"$namespace/$name"} = $action;
425 $self->_container_hash->{$namespace} = $container;
428 sub _find_or_create_action_container {
429 my ( $self, $namespace ) = @_;
431 my $tree ||= $self->_tree;
433 return $tree->getNodeValue unless $namespace;
435 my @namespace = split '/', $namespace;
436 return $self->_find_or_create_namespace_node( $tree, @namespace )
440 sub _find_or_create_namespace_node {
441 my ( $self, $parent, $part, @namespace ) = @_;
443 return $parent unless $part;
446 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
449 my $container = Catalyst::ActionContainer->new($part);
450 $parent->addChild( $child = Tree::Simple->new($container) );
453 $self->_find_or_create_namespace_node( $child, @namespace );
456 =head2 $self->setup_actions( $class, $context )
462 my ( $self, $c ) = @_;
466 $self->_load_dispatch_types( @{ $self->preload_dispatch_types } );
467 @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes;
469 foreach my $comp ( values %{ $c->components } ) {
470 $comp->register_actions($c) if $comp->can('register_actions');
473 $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
475 return unless $c->debug;
477 my $privates = Text::SimpleTable->new(
485 my ( $walker, $parent, $prefix ) = @_;
486 $prefix .= $parent->getNodeValue || '';
487 $prefix .= '/' unless $prefix =~ /\/$/;
488 my $node = $parent->getNodeValue->actions;
490 for my $action ( keys %{$node} ) {
491 my $action_obj = $node->{$action};
493 if ( ( $action =~ /^_.*/ )
494 && ( !$c->config->{show_internal_actions} ) );
495 $privates->row( "$prefix$action", $action_obj->class, $action );
499 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
502 $walker->( $walker, $self->_tree, '' );
503 $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" )
506 # List all public actions
507 $_->list($c) for @{ $self->_dispatch_types };
510 sub _load_dispatch_types {
511 my ( $self, @types ) = @_;
515 # Preload action types
516 for my $type (@types) {
518 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
520 eval { Class::MOP::load_class($class) };
521 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
523 push @{ $self->_dispatch_types }, $class->new;
525 push @loaded, $class;
532 __PACKAGE__->meta->make_immutable;
540 Sebastian Riedel, C<sri@cpan.org>
541 Matt S Trout, C<mst@shadowcatsystems.co.uk>
545 This program is free software, you can redistribute it and/or modify it under
546 the same terms as Perl itself.