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 $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 '/';
336 push @containers, $self->container_hash->{$namespace};
337 } while ( $namespace =~ s#/[^/]+$## );
339 return reverse grep { defined } @containers, $self->container_hash->{''};
341 my @parts = split '/', $namespace;
344 =head2 $self->register( $c, $action )
346 Make sure all required dispatch types for this action are loaded, then
347 pass the action to our dispatch types so they can register it if required.
348 Also, set up the tree with the action containers.
353 my ( $self, $c, $action ) = @_;
355 my $registered = $self->registered_dispatch_types;
358 foreach my $key ( keys %{ $action->attributes } ) {
359 $priv++ if $key eq 'Private';
360 my $class = "Catalyst::DispatchType::$key";
361 unless ( $registered->{$class} ) {
362 eval "require $class";
363 push( @{ $self->dispatch_types }, $class->new ) unless $@;
364 $registered->{$class} = 1;
368 # Pass the action to our dispatch types so they can register it if reqd.
370 foreach my $type ( @{ $self->dispatch_types } ) {
371 $reg++ if $type->register( $c, $action );
374 return unless $reg + $priv;
376 my $namespace = $action->namespace;
377 my $name = $action->name;
379 my $container = $self->find_or_create_action_container($namespace);
381 # Set the method value
382 $container->add_action($action);
384 $self->action_hash->{"$namespace/$name"} = $action;
385 $self->container_hash->{$namespace} = $container;
388 sub find_or_create_action_container {
389 my ( $self, $namespace ) = @_;
391 my $tree ||= $self->tree;
393 return $tree->getNodeValue unless $namespace;
395 my @namespace = split '/', $namespace;
396 return $self->_find_or_create_namespace_node( $tree, @namespace )
400 sub _find_or_create_namespace_node {
401 my ( $self, $parent, $part, @namespace ) = @_;
403 return $parent unless $part;
406 ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0];
409 my $container = Catalyst::ActionContainer->new($part);
410 $parent->addChild( $child = Tree::Simple->new($container) );
413 $self->_find_or_create_namespace_node( $child, @namespace );
416 =head2 $self->setup_actions( $class, $context )
422 my ( $self, $c ) = @_;
424 $self->dispatch_types( [] );
425 $self->registered_dispatch_types( {} );
426 $self->method_action_class('Catalyst::Action');
427 $self->action_container_class('Catalyst::ActionContainer');
430 $self->do_load_dispatch_types( @{ $self->preload_dispatch_types } );
431 @{ $self->registered_dispatch_types }{@classes} = (1) x @classes;
433 foreach my $comp ( values %{ $c->components } ) {
434 $comp->register_actions($c) if $comp->can('register_actions');
437 $self->do_load_dispatch_types( @{ $self->postload_dispatch_types } );
439 return unless $c->debug;
441 my $privates = Text::SimpleTable->new(
449 my ( $walker, $parent, $prefix ) = @_;
450 $prefix .= $parent->getNodeValue || '';
451 $prefix .= '/' unless $prefix =~ /\/$/;
452 my $node = $parent->getNodeValue->actions;
454 for my $action ( keys %{$node} ) {
455 my $action_obj = $node->{$action};
457 if ( ( $action =~ /^_.*/ )
458 && ( !$c->config->{show_internal_actions} ) );
459 $privates->row( "$prefix$action", $action_obj->class, $action );
463 $walker->( $walker, $_, $prefix ) for $parent->getAllChildren;
466 $walker->( $walker, $self->tree, '' );
467 $c->log->debug( "Loaded Private actions:\n" . $privates->draw )
470 # List all public actions
471 $_->list($c) for @{ $self->dispatch_types };
474 sub do_load_dispatch_types {
475 my ( $self, @types ) = @_;
479 # Preload action types
480 for my $type (@types) {
482 ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
483 eval "require $class";
484 Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
486 push @{ $self->dispatch_types }, $class->new;
488 push @loaded, $class;
496 Sebastian Riedel, C<sri@cpan.org>
497 Matt S Trout, C<mst@shadowcatsystems.co.uk>
501 This program is free software, you can redistribute it and/or modify it under
502 the same terms as Perl itself.