X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FDispatcher.pm;h=f44b9dbb7444adb2b90634d715d1e3f3b3bfdc24;hp=9cbf8ad8b1065e3cb959db42bdae8a856cc70d08;hb=ea0e58d9d85d93bf94c3ffa6b4d7b71b200bbdf1;hpb=adb53907bc24efd5107242b120799325ed67e448 diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm index 9cbf8ad..f44b9db 100644 --- a/lib/Catalyst/Dispatcher.pm +++ b/lib/Catalyst/Dispatcher.pm @@ -11,6 +11,7 @@ use Catalyst::DispatchType::Index; use Text::SimpleTable; use Tree::Simple; use Tree::Simple::Visitor::FindByPath; +use Scalar::Util (); # Stringify to class use overload '""' => sub { return ref shift }, fallback => 1; @@ -132,103 +133,120 @@ Documented in L =cut - sub forward { - my ( $self, $c, $command ) = splice( @_, 0, 3 ); + my ( $self, $c, $command, @extra_params ) = @_; unless ($command) { $c->log->debug('Nothing to forward to') if $c->debug; return 0; } - my $args = [ @{ $c->request->arguments } ]; + my @args; + + if ( ref( $extra_params[-1] ) eq 'ARRAY' ) { + @args = @{ pop @extra_params } + } else { + # this is a copy, it may take some abuse from ->_invoke_as_path if the path had trailing parts + @args = @{ $c->request->arguments }; + } - @$args = @{ pop @_ } if ( ref( $_[-1] ) eq 'ARRAY' ); + my $action; - my $action = $self->_invoke_as_path( $c, $command, $args ) - || $self->_invoke_as_component( $c, $command, shift ); + # forward to a string path ("/foo/bar/gorch") or action object which stringifies to that + $action = $self->_invoke_as_path( $c, "$command", \@args ); - unless ( $action ) { - my $error = qq/Couldn't forward to command "$command": / . qq/Invalid action or component./; - $c->error($error); - $c->log->debug($error) if $c->debug; - return 0; - } + # forward to a component ( "MyApp::*::Foo" or $c->component("...") - a path or an object) + unless ($action) { + my $method = @extra_params ? $extra_params[0] : "process"; + $action = $self->_invoke_as_component( $c, $command, $method ); + } - #push @$args, @_; - local $c->request->{arguments} = $args; - $action->execute($c); + unless ($action) { + my $error = + qq/Couldn't forward to command "$command": / + . qq/Invalid action or component./; + $c->error($error); + $c->log->debug($error) if $c->debug; + return 0; + } + + #push @$args, @_; + + local $c->request->{arguments} = \@args; + $action->dispatch( $c ); return $c->state; } sub _action_rel2abs { - my ( $self, $c, $path ) = @_; - - unless ( $path =~ m#^/# ) { - my $namespace = $c->stack->[-1]->namespace; - $path = "$namespace/$path"; - } - - $path =~ s#^/##; - return $path; + my ( $self, $c, $path ) = @_; + + unless ( $path =~ m#^/# ) { + my $namespace = $c->stack->[-1]->namespace; + $path = "$namespace/$path"; + } + + $path =~ s#^/##; + return $path; } sub _invoke_as_path { - my ( $self, $c, $rel_path, $args ) = @_; - - return if ref $rel_path; # it must be a string - - my $path = $self->_action_rel2abs( $c, $rel_path ); - - my ($tail, @extra_args); - while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) ) { # allow $path to be empty - if ( my $action = $c->get_action( $tail, $path ) ) { - push @$args, @extra_args; - return $action; - } else { - return unless $path; # if a match on the global namespace failed then the whole lookup failed - } - - unshift @extra_args, $tail; - } + my ( $self, $c, $rel_path, $args ) = @_; + + my $path = $self->_action_rel2abs( $c, $rel_path ); + + my ( $tail, @extra_args ); + while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) ) + { # allow $path to be empty + if ( my $action = $c->get_action( $tail, $path ) ) { + push @$args, @extra_args; + return $action; + } + else { + return + unless $path + ; # if a match on the global namespace failed then the whole lookup failed + } + + unshift @extra_args, $tail; + } } sub _find_component_class { - my ( $self, $c, $component ) = @_; + my ( $self, $c, $component ) = @_; - return ref($component) - || ref( $c->component($component) ) - || $c->component($component) + return ref($component) + || ref( $c->component($component) ) + || $c->component($component); } sub _invoke_as_component { - my ( $self, $c, $component, $method ) = @_; - - my $class = $self->_find_component_class( $c, $component ) || return 0; - $method ||= "process"; - - if ( my $code = $class->can($method) ) { - return $self->method_action_class->new( - { - name => $method, - code => $code, - reverse => "$class->$method", - class => $class, - namespace => Catalyst::Utils::class2prefix( - $class, $c->config->{case_sensitive} - ), - } - ); - } else { - my $error = - qq/Couldn't forward to "$class". Does not implement "$method"/; - $c->error($error); - $c->log->debug($error) - if $c->debug; - return 0; - } + my ( $self, $c, $component, $method ) = @_; + + my $class = $self->_find_component_class( $c, $component ) || return 0; + + if ( my $code = $class->can($method) ) { + return $self->method_action_class->new( + { + name => $method, + code => $code, + reverse => "$class->$method", + class => $class, + namespace => Catalyst::Utils::class2prefix( + $class, $c->config->{case_sensitive} + ), + } + ); + } + else { + my $error = + qq/Couldn't forward to "$class". Does not implement "$method"/; + $c->error($error); + $c->log->debug($error) + if $c->debug; + return 0; + } } =head2 $self->prepare_action($c) @@ -280,12 +298,25 @@ returns a named action from a given namespace. sub get_action { my ( $self, $name, $namespace ) = @_; return unless $name; - $namespace ||= ''; - $namespace = '' if $namespace eq '/'; + + $namespace = join( "/", grep { length } split '/', $namespace || "" ); return $self->action_hash->{"$namespace/$name"}; } +=head2 $self->get_action_by_path( $path ); + +Returns the named action by its full path. + +=cut + +sub get_action_by_path { + my ( $self, $path ) = @_; + $path =~ s/^\///; + $path = "/$path" unless $path =~ /\//; + $self->action_hash->{$path}; +} + =head2 $self->get_actions( $c, $action, $namespace ) =cut @@ -293,8 +324,8 @@ sub get_action { sub get_actions { my ( $self, $c, $action, $namespace ) = @_; return [] unless $action; - $namespace ||= ''; - $namespace = '' if $namespace eq '/'; + + $namespace = join( "/", grep { length } split '/', $namespace || "" ); my @match = $self->get_containers($namespace); @@ -314,15 +345,38 @@ sub get_containers { my @containers; - do { - push @containers, $self->container_hash->{$namespace}; - } while ( $namespace =~ s#/[^/]+$## ); + if ( length $namespace ) { + do { + push @containers, $self->container_hash->{$namespace}; + } while ( $namespace =~ s#/[^/]+$## ); + } return reverse grep { defined } @containers, $self->container_hash->{''}; my @parts = split '/', $namespace; } +=head2 $self->uri_for_action($action, \@captures) + +Takes a Catalyst::Action object and action parameters and returns a URI +part such that if $c->req->path were this URI part, this action would be +dispatched to with $c->req->captures set to the supplied arrayref. + +If the action object is not available for external dispatch or the dispatcher +cannot determine an appropriate URI, this method will return undef. + +=cut + +sub uri_for_action { + my ( $self, $action, $captures) = @_; + $captures ||= []; + foreach my $dispatch_type ( @{ $self->dispatch_types } ) { + my $uri = $dispatch_type->uri_for_action( $action, $captures ); + return $uri if defined($uri); + } + return undef; +} + =head2 $self->register( $c, $action ) Make sure all required dispatch types for this action are loaded, then @@ -422,7 +476,7 @@ sub setup_actions { my $privates = Text::SimpleTable->new( [ 20, 'Private' ], - [ 38, 'Class' ], + [ 36, 'Class' ], [ 12, 'Method' ] );