lib/Catalyst/DispatchType/Default.pm

   1 package Catalyst::DispatchType::Default;
   2
   3 use Moose;
   4 extends 'Catalyst::DispatchType';
   5
   6
   7 #use strict;
   8 #use base qw/Catalyst::DispatchType/;
   9
  10 =head1 NAME
  11
  12 Catalyst::DispatchType::Default - Default DispatchType
  13
  14 =head1 SYNOPSIS
  15
  16 See L<Catalyst>.
  17
  18 =head1 DESCRIPTION
  19
  20 =head1 METHODS
  21
  22 =head2 $self->match( $c, $path )
  23
  24 If path is empty (i.e. all path parts have been converted into args),
  25 attempts to find a default for the namespace constructed from the args,
  26 or the last inherited default otherwise and will match that.
  27
  28 If path is not empty, never matches since Default will only match if all
  29 other possibilities have been exhausted.
  30
  31 =cut
  32
  33 sub match {
  34     my ( $self, $c, $path ) = @_;
  35     return if $path =~ m!/!;    # Not at root yet, wait for it ...
  36     my $result = ( $c->get_actions( 'default', $c->req->path ) )[-1];
  37
  38     # Find default on namespace or super
  39     if ($result && $result->match($c)) {
  40         $c->action($result);
  41         $c->namespace( $result->namespace );
  42         $c->req->action('default');
  43
  44         # default methods receive the controller name as the first argument
  45         unshift @{ $c->req->args }, $path if $path;
  46         $c->req->match('');
  47         return 1;
  48     }
  49     return 0;
  50 }
  51
  52 =head1 AUTHOR
  53
  54 Matt S Trout
  55 Sebastian Riedel, C<sri@cpan.org>
  56
  57 =head1 COPYRIGHT
  58
  59 This program is free software, you can redistribute it and/or modify it under
  60 the same terms as Perl itself.
  61
  62 =cut
  63
  64 __PACKAGE__->meta->make_immutable;
  65
  66 1;