X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FDispatcher.pm;h=cb019340dfe65c23342ab3c859eea8db7945232d;hb=21465c884872c1ec8c30acd72796445f9eaacb31;hp=1f0dea9b122fb3f25e962c97e40697a2951ecc46;hpb=40d15eb0e6380c6601191be22fb31c16cc03a534;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm index 1f0dea9..cb01934 100644 --- a/lib/Catalyst/Dispatcher.pm +++ b/lib/Catalyst/Dispatcher.pm @@ -24,15 +24,16 @@ See L. =over 4 -=item $c->detach($command) +=item $c->detach( $command [, \@arguments ] ) Like C but doesn't return. =cut sub detach { - my ( $c, $command ) = @_; - $c->forward($command) if $command; + my ( $c, $command, @args ) = @_; + $c->forward( $command, @args ) if $command; + # die with DETACH signal, which will be caught in dispatching. die $Catalyst::Engine::DETACH; } @@ -92,9 +93,7 @@ sub dispatch { $c->execute( @{ $end->[0] } ); return if scalar @{ $c->error }; } - } - - else { + } else { my $path = $c->req->path; my $error = $path ? qq/Unknown resource "$path"/ @@ -128,7 +127,10 @@ sub forward { return 0; } - my $caller = caller(0); + # Relative forwards from detach + my $caller = ( caller(0) )[0]->isa('Catalyst::Dispatcher') + && ( ( caller(1) )[3] =~ /::detach$/ ) ? caller(1) : caller(0); + my $namespace = '/'; my $arguments = ( ref( $_[-1] ) eq 'ARRAY' ) ? pop(@_) : $c->req->args; @@ -148,34 +150,22 @@ sub forward { my $results = $c->get_action( $command, $namespace ); unless ( @{$results} ) { - my $class = $command || ''; - my $path = $class . '.pm'; - $path =~ s/::/\//g; - - unless ( $INC{$path} ) { - my $error = - qq/Couldn't forward to "$class". Invalid or not loaded./; - $c->error($error); - $c->log->debug($error) if $c->debug; - return 0; - } - unless ( UNIVERSAL::isa( $class, 'Catalyst::Base' ) ) { + unless ( defined( $c->components->{$command} ) ) { my $error = - qq/Can't forward to "$class". Class is not a Catalyst component./; +qq/Couldn't forward to command "$command". Invalid action or component./; $c->error($error); $c->log->debug($error) if $c->debug; return 0; } + my $class = $command; my $method = shift || 'process'; - if ( my $code = $class->can($method) ) { + if ( my $code = $c->components->{$class}->can($method) ) { $c->actions->{reverse}->{"$code"} = "$class->$method"; $results = [ [ [ $class, $code ] ] ]; - } - - else { + } else { my $error = qq/Couldn't forward to "$class". Does not implement "$method"/; $c->error($error); @@ -185,8 +175,8 @@ sub forward { } } - - local $c->request->{arguments} = [ @{ $arguments } ]; + + local $c->request->{arguments} = [ @{$arguments} ]; for my $result ( @{$results} ) { $c->execute( @{ $result->[0] } ); @@ -219,6 +209,7 @@ sub get_action { push @results, [$result] if $result; my $visitor = Tree::Simple::Visitor::FindByPath->new; + SEARCH: for my $part ( split '/', $namespace ) { $visitor->setSearchPath($part); $parent->accept($visitor); @@ -226,7 +217,12 @@ sub get_action { my $uid = $child->getUID if $child; my $match = $c->actions->{private}->{$uid}->{$action} if $uid; push @results, [$match] if $match; - $parent = $child if $child; + if ($child) { + $parent = $child; + } + else { + last SEARCH; + } } } @@ -330,15 +326,15 @@ sub set_action { if ( $flags{path} ) { $flags{path} =~ s/^\w+//; $flags{path} =~ s/\w+$//; - if ( $flags{path} =~ /^'(.*)'$/ ) { $flags{path} = $1 } - if ( $flags{path} =~ /^"(.*)"$/ ) { $flags{path} = $1 } + if ( $flags{path} =~ /^\s*'(.*)'\s*$/ ) { $flags{path} = $1 } + if ( $flags{path} =~ /^\s*"(.*)"\s*$/ ) { $flags{path} = $1 } } if ( $flags{regex} ) { $flags{regex} =~ s/^\w+//; $flags{regex} =~ s/\w+$//; - if ( $flags{regex} =~ /^'(.*)'$/ ) { $flags{regex} = $1 } - if ( $flags{regex} =~ /^"(.*)"$/ ) { $flags{regex} = $1 } + if ( $flags{regex} =~ /^\s*'(.*)'\s*$/ ) { $flags{regex} = $1 } + if ( $flags{regex} =~ /^\s*"(.*)"\s*$/ ) { $flags{regex} = $1 } } my $reverse = $prefix ? "$prefix/$method" : $method;