start using Class::C3, may need to add a reinitalize bit later, not sure
[catagits/Catalyst-Runtime.git] / lib / Catalyst / DispatchType / Regex.pm
CommitLineData
b96f127f 1package Catalyst::DispatchType::Regex;
2
0fc2d522 3use Class::C3;
3c0186f2 4use Moose;
5extends 'Catalyst::DispatchType::Path';
e8b9f2a9 6
8c113188 7use Text::SimpleTable;
ea0e58d9 8use Text::Balanced ();
b96f127f 9
e8b9f2a9 10has _compiled => (
11 is => 'rw',
12 isa => 'ArrayRef',
13 required => 1,
14 default => sub{ [] },
15 );
3c0186f2 16
0fc2d522 17no Moose;
18
2633d7dc 19=head1 NAME
b96f127f 20
2633d7dc 21Catalyst::DispatchType::Regex - Regex DispatchType
b96f127f 22
2633d7dc 23=head1 SYNOPSIS
24
25See L<Catalyst>.
26
27=head1 DESCRIPTION
28
29=head1 METHODS
30
b5ecfcf0 31=head2 $self->list($c)
a9cbd748 32
4ab87e27 33Output a table of all regex actions, and their private equivalent.
34
a9cbd748 35=cut
36
37sub list {
38 my ( $self, $c ) = @_;
34d28dfd 39 my $re = Text::SimpleTable->new( [ 35, 'Regex' ], [ 36, 'Private' ] );
e8b9f2a9 40 for my $regex ( @{ $self->_compiled } ) {
694d15f1 41 my $action = $regex->{action};
dcc61a75 42 $re->row( $regex->{path}, "/$action" );
a9cbd748 43 }
e8b9f2a9 44 $c->log->debug( "Loaded Regex actions:\n" . $re->draw . "\n" )
45 if ( @{ $self->_compiled } );
a9cbd748 46}
47
b5ecfcf0 48=head2 $self->match( $c, $path )
2633d7dc 49
b2b90ec2 50Checks path against every compiled regex, and offers the action for any regex
51which matches a chance to match the request. If it succeeds, sets action,
52match and captures on $c->req and returns 1. If not, returns 0 without
53altering $c.
4ab87e27 54
2633d7dc 55=cut
56
e8b9f2a9 57sub match {
2633d7dc 58 my ( $self, $c, $path ) = @_;
59
e8b9f2a9 60 return if $self->SUPER::match( $c, $path );
2633d7dc 61
62 # Check path against plain text first
63
3c0186f2 64 foreach my $compiled ( @{ $self->_compiled } ) {
2982e768 65 if ( my @captures = ( $path =~ $compiled->{re} ) ) {
4082e678 66 next unless $compiled->{action}->match($c);
2633d7dc 67 $c->req->action( $compiled->{path} );
b96f127f 68 $c->req->match($path);
2982e768 69 $c->req->captures( \@captures );
2633d7dc 70 $c->action( $compiled->{action} );
11bd4e3e 71 $c->namespace( $compiled->{action}->namespace );
b96f127f 72 return 1;
73 }
74 }
75
76 return 0;
e8b9f2a9 77}
b96f127f 78
b5ecfcf0 79=head2 $self->register( $c, $action )
2633d7dc 80
b2b90ec2 81Registers one or more regex actions for an action object.
4ab87e27 82Also registers them as literal paths.
83
b2b90ec2 84Returns 1 if any regexps were registered.
4ab87e27 85
2633d7dc 86=cut
87
88sub register {
b96f127f 89 my ( $self, $c, $action ) = @_;
34d28dfd 90 my $attrs = $action->attributes;
27708fc5 91 my @register = @{ $attrs->{'Regex'} || [] };
081def36 92
b96f127f 93 foreach my $r (@register) {
081def36 94 $self->register_path( $c, $r, $action );
95 $self->register_regex( $c, $r, $action );
b96f127f 96 }
27708fc5 97
694d15f1 98 return 1 if @register;
99 return 0;
b96f127f 100}
101
b5ecfcf0 102=head2 $self->register_regex($c, $re, $action)
081def36 103
3c0186f2 104Register an individual regex on the action. Usually called from the
b2b90ec2 105register method.
4ab87e27 106
081def36 107=cut
108
109sub register_regex {
110 my ( $self, $c, $re, $action ) = @_;
111 push(
3c0186f2 112 @{ $self->_compiled }, # and compiled regex for us
081def36 113 {
114 re => qr#$re#,
115 action => $action,
116 path => $re,
117 }
118 );
119}
120
ea0e58d9 121=head2 $self->uri_for_action($action, $captures)
122
123returns a URI for this action if it can find a regex attributes that contains
124the correct number of () captures. Note that this may function incorrectly
125in the case of nested captures - if your regex does (...(..))..(..) you'll
126need to pass the first and third captures only.
127
128=cut
129
130sub uri_for_action {
131 my ( $self, $action, $captures ) = @_;
132
133 if (my $regexes = $action->attributes->{Regex}) {
134 REGEX: foreach my $orig (@$regexes) {
135 my $re = "$orig";
136 $re =~ s/^\^//;
137 $re =~ s/\$$//;
138 my $final = '/';
139 my @captures = @$captures;
140 while (my ($front, $rest) = split(/\(/, $re, 2)) {
141 ($rest, $re) =
142 Text::Balanced::extract_bracketed("(${rest}", '(');
143 next REGEX unless @captures;
144 $final .= $front.shift(@captures);
145 }
146 next REGEX if @captures;
147 return $final;
148 }
149 }
150 return undef;
151}
152
2633d7dc 153=head1 AUTHOR
154
155Matt S Trout
156Sebastian Riedel, C<sri@cpan.org>
157
158=head1 COPYRIGHT
159
160This program is free software, you can redistribute it and/or modify it under
161the same terms as Perl itself.
162
163=cut
164
e5ecd5bc 165__PACKAGE__->meta->make_immutable;
166
b96f127f 1671;