1 package Catalyst::Dispatcher;
4 use base 'Class::Accessor::Fast';
5 use Catalyst::Exception;
8 use Catalyst::ActionContainer;
9 use Catalyst::DispatchType::Default;
10 use Catalyst::DispatchType::Index;
11 use Text::SimpleTable;
13 use Tree::Simple::Visitor::FindByPath;
16 use overload '""' => sub { return ref shift }, fallback => 1;
18 __PACKAGE__->mk_accessors(
19 qw/tree dispatch_types registered_dispatch_types
20 method_action_class action_container_class
21 preload_dispatch_types postload_dispatch_types
22 action_hash container_hash
26 # Preload these action types
27 our @PRELOAD = qw/Index Path Regex/;
29 # Postload these action types
30 our @POSTLOAD = qw/Default/;
34 Catalyst::Dispatcher - The Catalyst Dispatcher
42 This is the class that maps public urls to actions in your Catalyst
43 application based on the attributes you set.
49 Construct a new dispatcher.
55 my $class = ref($self) || $self;
57 my $obj = $class->SUPER::new(@_);
59 # set the default pre- and and postloads
60 $obj->preload_dispatch_types( \@PRELOAD );
61 $obj->postload_dispatch_types( \@POSTLOAD );
62 $obj->action_hash( {} );
63 $obj->container_hash( {} );
65 # Create the root node of the tree
67 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
68 $obj->tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
73 =head2 $self->preload_dispatch_types
75 An arrayref of pre-loaded dispatchtype classes
77 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
78 To use a custom class outside the regular C<Catalyst> namespace, prefix
79 it with a C<+>, like so:
83 =head2 $self->postload_dispatch_types
85 An arrayref of post-loaded dispatchtype classes
87 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
88 To use a custom class outside the regular C<Catalyst> namespace, prefix
89 it with a C<+>, like so:
93 =head2 $self->detach( $c, $command [, \@arguments ] )
95 Documented in L<Catalyst>
100 my ( $self, $c, $command, @args ) = @_;
101 $c->forward( $command, @args ) if $command;
102 die $Catalyst::DETACH;
105 =head2 $self->dispatch($c)
107 Delegate the dispatch to the action that matched the url, or return a
108 message about unknown resource
114 my ( $self, $c ) = @_;
116 $c->forward( join( '/', '', $c->action->namespace, '_DISPATCH' ) );
120 my $path = $c->req->path;
122 ? qq/Unknown resource "$path"/
123 : "No default action defined";
124 $c->log->error($error) if $c->debug;
129 =head2 $self->forward( $c, $command [, \@arguments ] )
131 Documented in L<Catalyst>
141 $c->log->debug('Nothing to forward to') if $c->debug;
146 my $arguments = $c->req->args;
147 if ( ref( $_[-1] ) eq 'ARRAY' ) {
148 $arguments = pop(@_);
154 unless ( ref $command ) {
155 my $command_copy = $command;
157 unless ( $command_copy =~ s/^\/// ) {
158 my $namespace = $c->stack->[-1]->namespace;
159 $command_copy = "${namespace}/${command}";
162 unless ( $command_copy =~ /\// ) {
163 $result = $c->get_action( $command_copy, '/' );
167 DESCEND: while ( $command_copy =~ s/^(.*)\/(\w+)$/$1/ ) {
169 $result = $c->get_action( $tail, $1 );
173 unshift( @{$arguments}, @extra_args );
176 unshift( @extra_args, $tail );
183 my $class = ref($command)
184 || ref( $c->component($command) )
185 || $c->component($command);
186 my $method = shift || 'process';
190 qq/Couldn't forward to command "$command". Invalid action or component./;
192 $c->log->debug($error) if $c->debug;
196 if ( my $code = $class->can($method) ) {
197 my $action = $self->method_action_class->new(
201 reverse => "$class->$method",
203 namespace => Catalyst::Utils::class2prefix(
204 $class, $c->config->{case_sensitive}
213 qq/Couldn't forward to "$class". Does not implement "$method"/;
215 $c->log->debug($error)
223 local $c->request->{arguments} = [ @{$arguments} ];
224 $result->execute($c);
226 else { $result->execute($c) }
231 =head2 $self->prepare_action($c)
233 Find an dispatch type that matches $c->req->path, and set args from it.
238 my ( $self, $c ) = @_;
239 my $path = $c->req->path;
240 my @path = split /\//, $c->req->path;
241 $c->req->args( \my @args );
243 unshift( @path, '' ); # Root action
245 DESCEND: while (@path) {
246 $path = join '/', @path;
249 $path = '' if $path eq '/'; # Root action
251 # Check out dispatch types to see if any will handle the path at
254 foreach my $type ( @{ $self->dispatch_types } ) {
255 last DESCEND if $type->match( $c, $path );
258 # If not, move the last part path to args
259 my $arg = pop(@path);
260 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
264 $c->log->debug( 'Path is "' . $c->req->match . '"' )
265 if ( $c->debug && $c->req->match );
267 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
268 if ( $c->debug && @args );
271 =head2 $self->get_action( $action, $namespace )
273 returns a named action from a given namespace.
278 my ( $self, $name, $namespace ) = @_;
281 $namespace = '' if $namespace eq '/';
283 return $self->action_hash->{"$namespace/$name"};
286 =head2 $self->get_actions( $c, $action, $namespace )
291 my ( $self, $c, $action, $namespace ) = @_;
292 return [] unless $action;
294 $namespace = '' if $namespace eq '/';
296 my @match = $self->get_containers($namespace);
298 return map { $_->get_action($action) } @match;
301 =head2 $self->get_containers( $namespace )
303 Return all the action containers for a given namespace, inclusive
308 my ( $self, $namespace ) = @_;
310 $namespace = '' if $namespace eq '/';
315 push @containers, $self->container_hash->{$namespace};
316 } while ( $namespace =~ s#/[^/]+$## );
318 return reverse grep { defined } @containers, $self->container_hash->{''};
320 my @parts = split '/', $namespace;
323 =head2 $self->register( $c, $action )
325 Make sure all required dispatch types for this action are loaded, then
326 pass the action to our dispatch types so they can register it if required.
327 Also, set up the tree with the action containers.
332 my ( $self, $c, $action ) = @_;
334 my $registered = $self->registered_dispatch_types;
337 foreach my $key ( keys %{ $action->attributes } ) {
338 $priv++ if $key eq 'Private';
339 my $class = "Catalyst::DispatchType::$key";
340 unless ( $registered->{$class} ) {
341 eval "require $class";
342 push( @{ $self->dispatch_types }, $class->new ) unless $@;
343 $registered->{$class} = 1;
347 # Pass the action to our dispatch types so they can register it if reqd.
349 foreach my $type ( @{ $self->dispatch_types } ) {
350 $reg++ if $type->register( $c, $action );
353 return unless $reg + $priv;
355 my $namespace = $action->namespace;
356 my $name = $action->name;
358 my $container = $self->find_or_create_action_container($namespace);
360 # Set the method value
361 $container->add_action($action);
363 $self->action_hash->{"$namespace/$name"} = $action;
364 $self->container_hash->{$namespace} = $container;
367 sub find_or_create_action_container {
368 my ( $self, $namespace ) = @_;
370 my $tree ||= $self->tree;
372 return $tree->getNodeValue unless $namespace;
374 my @namespace = split '/', $namespace;
375 return $self->_find_or_create_namespace_node( $tree, @namespace )
379 sub _find_or_create_namespace_node {
380 my ( $self, $parent, $part, @namespace ) = @_;
382 return $parent unless $part;
385 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
388 my $container = Catalyst::ActionContainer->new($part);
389 $parent->addChild( $child = Tree::Simple->new($container) );
392 $self->_find_or_create_namespace_node( $child, @namespace );
395 =head2 $self->setup_actions( $class, $context )
401 my ( $self, $c ) = @_;
403 $self->dispatch_types( [] );
404 $self->registered_dispatch_types( {} );
405 $self->method_action_class('Catalyst::Action');
406 $self->action_container_class('Catalyst::ActionContainer');
409 $self->do_load_dispatch_types( @{ $self->preload_dispatch_types } );
410 @{ $self->registered_dispatch_types }{@classes} = (1) x @classes;
412 foreach my $comp ( values %{ $c->components } ) {
413 $comp->register_actions($c) if $comp->can('register_actions');
416 $self->do_load_dispatch_types( @{ $self->postload_dispatch_types } );
418 return unless $c->debug;
420 my $privates = Text::SimpleTable->new(
428 my ( $walker, $parent, $prefix ) = @_;
429 $prefix .= $parent->getNodeValue || '';
430 $prefix .= '/' unless $prefix =~ /\/$/;
431 my $node = $parent->getNodeValue->actions;
433 for my $action ( keys %{$node} ) {
434 my $action_obj = $node->{$action};
436 if ( ( $action =~ /^_.*/ )
437 && ( !$c->config->{show_internal_actions} ) );
438 $privates->row( "$prefix$action", $action_obj->class, $action );
442 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
445 $walker->( $walker, $self->tree, '' );
446 $c->log->debug( "Loaded Private actions:\n" . $privates->draw )
449 # List all public actions
450 $_->list($c) for @{ $self->dispatch_types };
453 sub do_load_dispatch_types {
454 my ( $self, @types ) = @_;
458 # Preload action types
459 for my $type (@types) {
461 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
462 eval "require $class";
463 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
465 push @{ $self->dispatch_types }, $class->new;
467 push @loaded, $class;
475 Sebastian Riedel, C<sri@cpan.org>
476 Matt S Trout, C<mst@shadowcatsystems.co.uk>
480 This program is free software, you can redistribute it and/or modify it under
481 the same terms as Perl itself.