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>
136 my ( $self, $c, $command ) = splice( @_, 0, 3 );
139 $c->log->debug('Nothing to forward to') if $c->debug;
143 my $args = [ @{ $c->request->arguments } ];
145 @$args = @{ pop @_ } if ( ref( $_[-1] ) eq 'ARRAY' );
147 my $action = $self->_invoke_as_path( $c, $command, $args )
148 || $self->_invoke_as_component( $c, $command, shift );
152 qq/Couldn't forward to command "$command": /
153 . qq/Invalid action or component./;
155 $c->log->debug($error) if $c->debug;
161 local $c->request->{arguments} = $args;
162 $action->execute($c);
167 sub _action_rel2abs {
168 my ( $self, $c, $path ) = @_;
170 unless ( $path =~ m#^/# ) {
171 my $namespace = $c->stack->[-1]->namespace;
172 $path = "$namespace/$path";
179 sub _invoke_as_path {
180 my ( $self, $c, $rel_path, $args ) = @_;
182 return if ref $rel_path; # it must be a string
184 my $path = $self->_action_rel2abs( $c, $rel_path );
186 my ( $tail, @extra_args );
187 while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) )
188 { # allow $path to be empty
189 if ( my $action = $c->get_action( $tail, $path ) ) {
190 push @$args, @extra_args;
196 ; # if a match on the global namespace failed then the whole lookup failed
199 unshift @extra_args, $tail;
203 sub _find_component_class {
204 my ( $self, $c, $component ) = @_;
206 return ref($component)
207 || ref( $c->component($component) )
208 || $c->component($component);
211 sub _invoke_as_component {
212 my ( $self, $c, $component, $method ) = @_;
214 my $class = $self->_find_component_class( $c, $component ) || return 0;
215 $method ||= "process";
217 if ( my $code = $class->can($method) ) {
218 return $self->method_action_class->new(
222 reverse => "$class->$method",
224 namespace => Catalyst::Utils::class2prefix(
225 $class, $c->config->{case_sensitive}
232 qq/Couldn't forward to "$class". Does not implement "$method"/;
234 $c->log->debug($error)
240 =head2 $self->prepare_action($c)
242 Find an dispatch type that matches $c->req->path, and set args from it.
247 my ( $self, $c ) = @_;
248 my $path = $c->req->path;
249 my @path = split /\//, $c->req->path;
250 $c->req->args( \my @args );
252 unshift( @path, '' ); # Root action
254 DESCEND: while (@path) {
255 $path = join '/', @path;
258 $path = '' if $path eq '/'; # Root action
260 # Check out dispatch types to see if any will handle the path at
263 foreach my $type ( @{ $self->dispatch_types } ) {
264 last DESCEND if $type->match( $c, $path );
267 # If not, move the last part path to args
268 my $arg = pop(@path);
269 $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
273 $c->log->debug( 'Path is "' . $c->req->match . '"' )
274 if ( $c->debug && $c->req->match );
276 $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
277 if ( $c->debug && @args );
280 =head2 $self->get_action( $action, $namespace )
282 returns a named action from a given namespace.
287 my ( $self, $name, $namespace ) = @_;
290 $namespace = join("/", grep { length } split '/', $namespace || "" );
292 return $self->action_hash->{"$namespace/$name"};
295 =head2 $self->get_action_by_path( $path );
297 returns the named action by it's full path.
301 sub get_action_by_path {
302 my ( $self, $path ) = @_;
303 $self->action_hash->{$path};
306 =head2 $self->get_actions( $c, $action, $namespace )
311 my ( $self, $c, $action, $namespace ) = @_;
312 return [] unless $action;
314 $namespace = join("/", grep { length } split '/', $namespace || "" );
316 my @match = $self->get_containers($namespace);
318 return map { $_->get_action($action) } @match;
321 =head2 $self->get_containers( $namespace )
323 Return all the action containers for a given namespace, inclusive
328 my ( $self, $namespace ) = @_;
330 $namespace = '' if $namespace eq '/';
335 push @containers, $self->container_hash->{$namespace};
336 } while ( $namespace =~ s#/[^/]+$## );
338 return reverse grep { defined } @containers, $self->container_hash->{''};
340 my @parts = split '/', $namespace;
343 =head2 $self->register( $c, $action )
345 Make sure all required dispatch types for this action are loaded, then
346 pass the action to our dispatch types so they can register it if required.
347 Also, set up the tree with the action containers.
352 my ( $self, $c, $action ) = @_;
354 my $registered = $self->registered_dispatch_types;
357 foreach my $key ( keys %{ $action->attributes } ) {
358 $priv++ if $key eq 'Private';
359 my $class = "Catalyst::DispatchType::$key";
360 unless ( $registered->{$class} ) {
361 eval "require $class";
362 push( @{ $self->dispatch_types }, $class->new ) unless $@;
363 $registered->{$class} = 1;
367 # Pass the action to our dispatch types so they can register it if reqd.
369 foreach my $type ( @{ $self->dispatch_types } ) {
370 $reg++ if $type->register( $c, $action );
373 return unless $reg + $priv;
375 my $namespace = $action->namespace;
376 my $name = $action->name;
378 my $container = $self->find_or_create_action_container($namespace);
380 # Set the method value
381 $container->add_action($action);
383 $self->action_hash->{"$namespace/$name"} = $action;
384 $self->container_hash->{$namespace} = $container;
387 sub find_or_create_action_container {
388 my ( $self, $namespace ) = @_;
390 my $tree ||= $self->tree;
392 return $tree->getNodeValue unless $namespace;
394 my @namespace = split '/', $namespace;
395 return $self->_find_or_create_namespace_node( $tree, @namespace )
399 sub _find_or_create_namespace_node {
400 my ( $self, $parent, $part, @namespace ) = @_;
402 return $parent unless $part;
405 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
408 my $container = Catalyst::ActionContainer->new($part);
409 $parent->addChild( $child = Tree::Simple->new($container) );
412 $self->_find_or_create_namespace_node( $child, @namespace );
415 =head2 $self->setup_actions( $class, $context )
421 my ( $self, $c ) = @_;
423 $self->dispatch_types( [] );
424 $self->registered_dispatch_types( {} );
425 $self->method_action_class('Catalyst::Action');
426 $self->action_container_class('Catalyst::ActionContainer');
429 $self->do_load_dispatch_types( @{ $self->preload_dispatch_types } );
430 @{ $self->registered_dispatch_types }{@classes} = (1) x @classes;
432 foreach my $comp ( values %{ $c->components } ) {
433 $comp->register_actions($c) if $comp->can('register_actions');
436 $self->do_load_dispatch_types( @{ $self->postload_dispatch_types } );
438 return unless $c->debug;
440 my $privates = Text::SimpleTable->new(
448 my ( $walker, $parent, $prefix ) = @_;
449 $prefix .= $parent->getNodeValue || '';
450 $prefix .= '/' unless $prefix =~ /\/$/;
451 my $node = $parent->getNodeValue->actions;
453 for my $action ( keys %{$node} ) {
454 my $action_obj = $node->{$action};
456 if ( ( $action =~ /^_.*/ )
457 && ( !$c->config->{show_internal_actions} ) );
458 $privates->row( "$prefix$action", $action_obj->class, $action );
462 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
465 $walker->( $walker, $self->tree, '' );
466 $c->log->debug( "Loaded Private actions:\n" . $privates->draw )
469 # List all public actions
470 $_->list($c) for @{ $self->dispatch_types };
473 sub do_load_dispatch_types {
474 my ( $self, @types ) = @_;
478 # Preload action types
479 for my $type (@types) {
481 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
482 eval "require $class";
483 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
485 push @{ $self->dispatch_types }, $class->new;
487 push @loaded, $class;
495 Sebastian Riedel, C<sri@cpan.org>
496 Matt S Trout, C<mst@shadowcatsystems.co.uk>
500 This program is free software, you can redistribute it and/or modify it under
501 the same terms as Perl itself.