X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FDispatchType%2FDefault.pm;h=5dcf1353256d6cd1363fb4853fbc2f8c9b9cef31;hp=dba3951fbceb410ccc4c3e4500b1d547a3f2c8bb;hb=0fc2d522eec43202c21e9f0062e43f10db4d9008;hpb=a9dc674c99f36ff40d94b80753a1504074ba5e22 diff --git a/lib/Catalyst/DispatchType/Default.pm b/lib/Catalyst/DispatchType/Default.pm index dba3951..5dcf135 100644 --- a/lib/Catalyst/DispatchType/Default.pm +++ b/lib/Catalyst/DispatchType/Default.pm @@ -1,7 +1,10 @@ package Catalyst::DispatchType::Default; -use strict; -use base qw/Catalyst::DispatchType/; +use Class::C3; +use Moose; +extends 'Catalyst::DispatchType'; + +no Moose; =head1 NAME @@ -15,32 +18,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_actions('default', $c->req->path))[-1]; + my $result = ( $c->get_actions( 'default', $c->req->path ) )[-1]; # Find default on namespace or super - if ($result) { - $c->action( $result ); + 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 +60,6 @@ the same terms as Perl itself. =cut +__PACKAGE__->meta->make_immutable; + 1;