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
25 # Preload these action types
26 our @PRELOAD = qw/Index Path Regex/;
28 # Postload these action types
29 our @POSTLOAD = qw/Default/;
33 Catalyst::Dispatcher - The Catalyst Dispatcher
41 This is the class that maps public urls to actions in your Catalyst
42 application based on the attributes you set.
48 Construct a new dispatcher.
54 my $class = ref($self) || $self;
56 my $obj = $class->SUPER::new( @_ );
58 # set the default pre- and and postloads
59 $obj->preload_dispatch_types( \@PRELOAD );
60 $obj->postload_dispatch_types( \@POSTLOAD );
64 =head2 $self->preload_dispatch_types
66 An arrayref of pre-loaded dispatchtype classes
68 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
69 To use a custom class outside the regular C<Catalyst> namespace, prefix
70 it with a C<+>, like so:
74 =head2 $self->postload_dispatch_types
76 An arrayref of post-loaded dispatchtype classes
78 Entries are considered to be available as C<Catalyst::DispatchType::CLASS>
79 To use a custom class outside the regular C<Catalyst> namespace, prefix
80 it with a C<+>, like so:
84 =head2 $self->detach( $c, $command [, \@arguments ] )
86 Documented in L<Catalyst>
91 my ( $self, $c, $command, @args ) = @_;
92 $c->forward( $command, @args ) if $command;
93 die $Catalyst::DETACH;
96 =head2 $self->dispatch($c)
98 Delegate the dispatch to the action that matched the url, or return a
99 message about unknown resource
105 my ( $self, $c ) = @_;
107 $c->forward( join( '/', '', $c->action->namespace, '_DISPATCH' ) );
111 my $path = $c->req->path;
113 ? qq/Unknown resource "$path"/
114 : "No default action defined";
115 $c->log->error($error) if $c->debug;
120 =head2 $self->forward( $c, $command [, \@arguments ] )
122 Documented in L<Catalyst>
132 $c->log->debug('Nothing to forward to') if $c->debug;
137 my $arguments = $c->req->args;
138 if ( ref( $_[-1] ) eq 'ARRAY' ) {
139 $arguments = pop(@_);
145 unless ( ref $command ) {
146 my $command_copy = $command;
148 unless ( $command_copy =~ s/^\/// ) {
149 my $namespace = $c->stack->[-1]->namespace;
150 $command_copy = "${namespace}/${command}";
153 unless ( $command_copy =~ /\// ) {
154 $result = $c->get_action( $command_copy, '/' );
158 DESCEND: while ( $command_copy =~ s/^(.*)\/(\w+)$/$1/ ) {
160 $result = $c->get_action( $tail, $1 );
164 unshift( @{$arguments}, @extra_args );
167 unshift( @extra_args, $tail );
174 my $class = ref($command)
175 || ref( $c->component($command) )
176 || $c->component($command);
177 my $method = shift || 'process';
181 qq/Couldn't forward to command "$command". Invalid action or component./;
183 $c->log->debug($error) if $c->debug;
187 if ( my $code = $class->can($method) ) {
188 my $action = $self->method_action_class->new(
192 reverse => "$class->$method",
194 namespace => Catalyst::Utils::class2prefix(
195 $class, $c->config->{case_sensitive}
204 qq/Couldn't forward to "$class". Does not implement "$method"/;
206 $c->log->debug($error)
214 local $c->request->{arguments} = [ @{$arguments} ];
215 $result->execute($c);
217 else { $result->execute($c) }
222 =head2 $self->prepare_action($c)
224 Find an dispatch type that matches $c->req->path, and set args from it.
229 my ( $self, $c ) = @_;
230 my $path = $c->req->path;
231 my @path = split /\//, $c->req->path;
232 $c->req->args( \my @args );
234 unshift( @path, '' ); # Root action
236 DESCEND: while (@path) {
237 $path = join '/', @path;
240 $path = '' if $path eq '/'; # Root action
242 # Check out dispatch types to see if any will handle the path at
245 foreach my $type ( @{ $self->dispatch_types } ) {
246 last DESCEND if $type->match( $c, $path );
249 # If not, move the last part path to args
250 my $arg = pop(@path);
251 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
255 $c->log->debug( 'Path is "' . $c->req->match . '"' )
256 if ( $c->debug && $c->req->match );
258 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
259 if ( $c->debug && @args );
262 =head2 $self->get_action( $action, $namespace )
264 returns a named action from a given namespace.
269 my ( $self, $name, $namespace ) = @_;
272 $namespace = '' if $namespace eq '/';
274 my @match = $self->get_containers($namespace);
276 return unless @match;
278 if ( my $action = $match[-1]->get_action($name) ) {
279 return $action if $action->namespace eq $namespace;
283 =head2 $self->get_actions( $c, $action, $namespace )
288 my ( $self, $c, $action, $namespace ) = @_;
289 return [] unless $action;
291 $namespace = '' if $namespace eq '/';
293 my @match = $self->get_containers($namespace);
295 return map { $_->get_action($action) } @match;
298 =head2 $self->get_containers( $namespace )
300 Return all the action containers for a given namespace, inclusive
305 my ( $self, $namespace ) = @_;
307 # If the namespace is / just return the root ActionContainer
309 return ( $self->tree->getNodeValue )
310 if ( !$namespace || ( $namespace eq '/' ) );
312 # Use a visitor to recurse down the tree finding the ActionContainers
313 # for each namespace in the chain.
315 my $visitor = Tree::Simple::Visitor::FindByPath->new;
316 my @path = split( '/', $namespace );
317 $visitor->setSearchPath(@path);
318 $self->tree->accept($visitor);
320 my @match = $visitor->getResults;
321 @match = ( $self->tree ) unless @match;
323 if ( !defined $visitor->getResult ) {
325 # If we don't manage to match, the visitor doesn't return the last
326 # node is matched, so foo/bar/baz would only find the 'foo' node,
327 # not the foo and foo/bar nodes as it should. This does another
328 # single-level search to see if that's the case, and the 'last unless'
329 # should catch any failures - or short-circuit this if this *is* a
330 # bug in the visitor and gets fixed.
332 if ( my $extra = $path[ ( scalar @match ) - 1 ] ) {
333 $visitor->setSearchPath($extra);
334 $match[-1]->accept($visitor);
335 push( @match, $visitor->getResult ) if defined $visitor->getResult;
339 return map { $_->getNodeValue } @match;
342 =head2 $self->register( $c, $action )
344 Make sure all required dispatch types for this action are loaded, then
345 pass the action to our dispatch types so they can register it if required.
346 Also, set up the tree with the action containers.
351 my ( $self, $c, $action ) = @_;
353 my $registered = $self->registered_dispatch_types;
356 foreach my $key ( keys %{ $action->attributes } ) {
357 $priv++ if $key eq 'Private';
358 my $class = "Catalyst::DispatchType::$key";
359 unless ( $registered->{$class} ) {
360 eval "require $class";
361 push( @{ $self->dispatch_types }, $class->new ) unless $@;
362 $registered->{$class} = 1;
366 # Pass the action to our dispatch types so they can register it if reqd.
368 foreach my $type ( @{ $self->dispatch_types } ) {
369 $reg++ if $type->register( $c, $action );
372 return unless $reg + $priv;
374 my $namespace = $action->namespace;
375 my $parent = $self->tree;
376 my $visitor = Tree::Simple::Visitor::FindByPath->new;
379 for my $part ( split '/', $namespace ) {
380 $visitor->setSearchPath($part);
381 $parent->accept($visitor);
382 my $child = $visitor->getResult;
386 # Create a new tree node and an ActionContainer to form
390 Catalyst::ActionContainer->new(
391 { part => $part, actions => {} } );
392 $child = $parent->addChild( Tree::Simple->new($container) );
393 $visitor->setSearchPath($part);
394 $parent->accept($visitor);
395 $child = $visitor->getResult;
402 # Set the method value
403 $parent->getNodeValue->actions->{ $action->name } = $action;
406 =head2 $self->setup_actions( $class, $context )
412 my ( $self, $c ) = @_;
414 $self->dispatch_types( [] );
415 $self->registered_dispatch_types( {} );
416 $self->method_action_class('Catalyst::Action');
417 $self->action_container_class('Catalyst::ActionContainer');
419 # Preload action types
420 for my $type ( @{$self->preload_dispatch_types} ) {
421 my $class = ($type =~ /^\+(.*)$/) ? $1 : "Catalyst::DispatchType::${type}";
422 eval "require $class";
423 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
425 push @{ $self->dispatch_types }, $class->new;
426 $self->registered_dispatch_types->{$class} = 1;
431 Catalyst::ActionContainer->new( { part => '/', actions => {} } );
432 $self->tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) );
434 foreach my $comp ( values %{ $c->components } ) {
435 $comp->register_actions($c) if $comp->can('register_actions');
438 # Postload action types
439 for my $type ( @{$self->postload_dispatch_types} ) {
440 my $class = ($type =~ /^\+(.*)$/) ? $1 : "Catalyst::DispatchType::${type}";
441 eval "require $class";
442 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
444 push @{ $self->dispatch_types }, $class->new;
447 return unless $c->debug;
449 my $privates = Text::SimpleTable->new(
457 my ( $walker, $parent, $prefix ) = @_;
458 $prefix .= $parent->getNodeValue || '';
459 $prefix .= '/' unless $prefix =~ /\/$/;
460 my $node = $parent->getNodeValue->actions;
462 for my $action ( keys %{$node} ) {
463 my $action_obj = $node->{$action};
465 if ( ( $action =~ /^_.*/ )
466 && ( !$c->config->{show_internal_actions} ) );
467 $privates->row( "$prefix$action", $action_obj->class, $action );
471 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
474 $walker->( $walker, $self->tree, '' );
475 $c->log->debug( "Loaded Private actions:\n" . $privates->draw )
478 # List all public actions
479 $_->list($c) for @{ $self->dispatch_types };
484 Sebastian Riedel, C<sri@cpan.org>
485 Matt S Trout, C<mst@shadowcatsystems.co.uk>
489 This program is free software, you can redistribute it and/or modify it under
490 the same terms as Perl itself.