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->dispatch( $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 its full path.
301 sub get_action_by_path {
302 my ( $self, $path ) = @_;
303 $path = "/$path" unless $path =~ /\//;
304 $self->action_hash->{$path};
307 =head2 $self->get_actions( $c, $action, $namespace )
312 my ( $self, $c, $action, $namespace ) = @_;
313 return [] unless $action;
315 $namespace = join( "/", grep { length } split '/', $namespace || "" );
317 my @match = $self->get_containers($namespace);
319 return map { $_->get_action($action) } @match;
322 =head2 $self->get_containers( $namespace )
324 Return all the action containers for a given namespace, inclusive
329 my ( $self, $namespace ) = @_;
331 $namespace = '' if $namespace eq '/';
335 if ( length $namespace ) {
337 push @containers, $self->container_hash->{$namespace};
338 } while ( $namespace =~ s#/[^/]+$## );
341 return reverse grep { defined } @containers, $self->container_hash->{''};
343 my @parts = split '/', $namespace;
346 =head2 $self->register( $c, $action )
348 Make sure all required dispatch types for this action are loaded, then
349 pass the action to our dispatch types so they can register it if required.
350 Also, set up the tree with the action containers.
355 my ( $self, $c, $action ) = @_;
357 my $registered = $self->registered_dispatch_types;
360 foreach my $key ( keys %{ $action->attributes } ) {
361 $priv++ if $key eq 'Private';
362 my $class = "Catalyst::DispatchType::$key";
363 unless ( $registered->{$class} ) {
364 eval "require $class";
365 push( @{ $self->dispatch_types }, $class->new ) unless $@;
366 $registered->{$class} = 1;
370 # Pass the action to our dispatch types so they can register it if reqd.
372 foreach my $type ( @{ $self->dispatch_types } ) {
373 $reg++ if $type->register( $c, $action );
376 return unless $reg + $priv;
378 my $namespace = $action->namespace;
379 my $name = $action->name;
381 my $container = $self->find_or_create_action_container($namespace);
383 # Set the method value
384 $container->add_action($action);
386 $self->action_hash->{"$namespace/$name"} = $action;
387 $self->container_hash->{$namespace} = $container;
390 sub find_or_create_action_container {
391 my ( $self, $namespace ) = @_;
393 my $tree ||= $self->tree;
395 return $tree->getNodeValue unless $namespace;
397 my @namespace = split '/', $namespace;
398 return $self->_find_or_create_namespace_node( $tree, @namespace )
402 sub _find_or_create_namespace_node {
403 my ( $self, $parent, $part, @namespace ) = @_;
405 return $parent unless $part;
408 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
411 my $container = Catalyst::ActionContainer->new($part);
412 $parent->addChild( $child = Tree::Simple->new($container) );
415 $self->_find_or_create_namespace_node( $child, @namespace );
418 =head2 $self->setup_actions( $class, $context )
424 my ( $self, $c ) = @_;
426 $self->dispatch_types( [] );
427 $self->registered_dispatch_types( {} );
428 $self->method_action_class('Catalyst::Action');
429 $self->action_container_class('Catalyst::ActionContainer');
432 $self->do_load_dispatch_types( @{ $self->preload_dispatch_types } );
433 @{ $self->registered_dispatch_types }{@classes} = (1) x @classes;
435 foreach my $comp ( values %{ $c->components } ) {
436 $comp->register_actions($c) if $comp->can('register_actions');
439 $self->do_load_dispatch_types( @{ $self->postload_dispatch_types } );
441 return unless $c->debug;
443 my $privates = Text::SimpleTable->new(
451 my ( $walker, $parent, $prefix ) = @_;
452 $prefix .= $parent->getNodeValue || '';
453 $prefix .= '/' unless $prefix =~ /\/$/;
454 my $node = $parent->getNodeValue->actions;
456 for my $action ( keys %{$node} ) {
457 my $action_obj = $node->{$action};
459 if ( ( $action =~ /^_.*/ )
460 && ( !$c->config->{show_internal_actions} ) );
461 $privates->row( "$prefix$action", $action_obj->class, $action );
465 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
468 $walker->( $walker, $self->tree, '' );
469 $c->log->debug( "Loaded Private actions:\n" . $privates->draw )
472 # List all public actions
473 $_->list($c) for @{ $self->dispatch_types };
476 sub do_load_dispatch_types {
477 my ( $self, @types ) = @_;
481 # Preload action types
482 for my $type (@types) {
484 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
485 eval "require $class";
486 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
488 push @{ $self->dispatch_types }, $class->new;
490 push @loaded, $class;
498 Sebastian Riedel, C<sri@cpan.org>
499 Matt S Trout, C<mst@shadowcatsystems.co.uk>
503 This program is free software, you can redistribute it and/or modify it under
504 the same terms as Perl itself.