X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FDispatchType%2FDefault.pm;h=ecc6e38572d1f430b6f2b9bb6e60c8639ea98c85;hb=afb82794328ff8da1efc0a4c37f3f3703c262c31;hp=08a49487627829fa1ad281d211d1d4312791ff54;hpb=ba599d1c7a0c3219cd3825264c44d22362ed179a;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/DispatchType/Default.pm b/lib/Catalyst/DispatchType/Default.pm index 08a4948..ecc6e38 100644 --- a/lib/Catalyst/DispatchType/Default.pm +++ b/lib/Catalyst/DispatchType/Default.pm @@ -1,7 +1,9 @@ package Catalyst::DispatchType::Default; -use strict; -use base qw/Catalyst::DispatchType/; +use Moose; +extends 'Catalyst::DispatchType'; + +no Moose; =head1 NAME @@ -15,32 +17,36 @@ See L. =head1 METHODS -=over 4 +=head2 $self->match( $c, $path ) + +If path is empty (i.e. all path parts have been converted into args), +attempts to find a default for the namespace constructed from the args, +or the last inherited default otherwise and will match that. -=item $self->match( $c, $path ) +If path is not empty, never matches since Default will only match if all +other possibilities have been exhausted. =cut sub match { my ( $self, $c, $path ) = @_; return if $path =~ m!/!; # Not at root yet, wait for it ... - my $result = @{ $c->get_action( 'default', $c->req->path, 1 ) || [] }[-1]; + my $result = ( $c->get_actions( 'default', $c->req->path ) )[-1]; # Find default on namespace or super - if ($result) { - $c->action( $result->[0] ); - $c->namespace( $result->[0]->namespace ); + if ($result && $result->match($c)) { + $c->action($result); + $c->namespace( $result->namespace ); $c->req->action('default'); + # default methods receive the controller name as the first argument - unshift @{ $c->req->args }, $path; + unshift @{ $c->req->args }, $path if $path; $c->req->match(''); return 1; } return 0; } -=back - =head1 AUTHOR Matt S Trout @@ -53,4 +59,6 @@ the same terms as Perl itself. =cut +__PACKAGE__->meta->make_immutable; + 1;