lib/Catalyst/DispatchType/Regex.pm

   1 package Catalyst::DispatchType::Regex;
   2
   3 use strict;
   4 use base qw/Catalyst::DispatchType::Path/;
   5
   6 =head1 NAME
   7
   8 Catalyst::DispatchType::Regex - Regex DispatchType
   9
  10 =head1 SYNOPSIS
  11
  12 See L<Catalyst>.
  13
  14 =head1 DESCRIPTION
  15
  16 =head1 METHODS
  17
  18 =over 4
  19
  20 =item $self->match( $c, $path )
  21
  22 =cut
  23
  24 sub match {
  25     my ( $self, $c, $path ) = @_;
  26
  27     return if $self->SUPER::match( $c, $path );
  28
  29     # Check path against plain text first
  30
  31     foreach my $compiled ( @{ $self->{compiled} || [] } ) {
  32         if ( my @snippets = ( $path =~ $compiled->{re} ) ) {
  33             $c->req->action( $compiled->{path} );
  34             $c->req->match($path);
  35             $c->req->snippets( \@snippets );
  36             $c->action( $compiled->{action} );
  37             $c->namespace( $compiled->{action}->prefix );
  38             return 1;
  39         }
  40     }
  41
  42     return 0;
  43 }
  44
  45 =item $self->register( $c, $action )
  46
  47 =cut
  48
  49 sub register {
  50     my ( $self, $c, $action ) = @_;
  51     my $attrs = $action->attributes;
  52     my @register = map { @{ $_ || [] } } @{$attrs}{ 'Regex', 'Regexp' };
  53     foreach my $r (@register) {
  54         $self->{paths}{$r} = $action;    # Register path for superclass
  55         push(
  56             @{ $self->{compiled} },      # and compiled regex for us
  57             {
  58                 re     => qr#$r#,
  59                 action => $action,
  60                 path   => $r,
  61             }
  62         );
  63     }
  64 }
  65
  66 =back
  67
  68 =head1 AUTHOR
  69
  70 Matt S Trout
  71 Sebastian Riedel, C<sri@cpan.org>
  72
  73 =head1 COPYRIGHT
  74
  75 This program is free software, you can redistribute it and/or modify it under
  76 the same terms as Perl itself.
  77
  78 =cut
  79
  80 1;