}
}
-sub _parse_Regex_attr {
- my ( $self, $c, $name, $value ) = @_;
- return ( 'Regex', $value );
-}
-
-sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
-
-sub _parse_LocalRegex_attr {
- my ( $self, $c, $name, $value ) = @_;
- unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
-
- my $prefix = $self->path_prefix( $c );
- $prefix .= '/' if length( $prefix );
-
- return ( 'Regex', "^${prefix}${value}" );
-}
-
-sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
-
sub _parse_Chained_attr {
my ($self, $c, $name, $value) = @_;
+++ /dev/null
-package Catalyst::DispatchType::Regex;
-
-use Moose;
-extends 'Catalyst::DispatchType::Path';
-
-use Text::SimpleTable;
-use Catalyst::Utils;
-use Text::Balanced ();
-
-has _compiled => (
- is => 'rw',
- isa => 'ArrayRef',
- required => 1,
- default => sub{ [] },
- );
-
-no Moose;
-
-=head1 NAME
-
-Catalyst::DispatchType::Regex - Regex DispatchType
-
-=head1 SYNOPSIS
-
-See L<Catalyst::DispatchType>.
-
-=head1 DESCRIPTION
-
-Dispatch type managing path-matching behaviour using regexes. For
-more information on dispatch types, see:
-
-=over 4
-
-=item * L<Catalyst::Manual::Intro> for how they affect application authors
-
-=item * L<Catalyst::DispatchType> for implementation information.
-
-=back
-
-=head1 METHODS
-
-=head2 $self->list($c)
-
-Output a table of all regex actions, and their private equivalent.
-
-=cut
-
-sub list {
- my ( $self, $c ) = @_;
- my $avail_width = Catalyst::Utils::term_width() - 9;
- my $col1_width = ($avail_width * .50) < 35 ? 35 : int($avail_width * .50);
- my $col2_width = $avail_width - $col1_width;
- my $re = Text::SimpleTable->new(
- [ $col1_width, 'Regex' ], [ $col2_width, 'Private' ]
- );
- for my $regex ( @{ $self->_compiled } ) {
- my $action = $regex->{action};
- $re->row( $regex->{path}, "/$action" );
- }
- $c->log->debug( "Loaded Regex actions:\n" . $re->draw . "\n" )
- if ( @{ $self->_compiled } );
-}
-
-=head2 $self->match( $c, $path )
-
-Checks path against every compiled regex, and offers the action for any regex
-which matches a chance to match the request. If it succeeds, sets action,
-match and captures on $c->req and returns 1. If not, returns 0 without
-altering $c.
-
-=cut
-
-sub match {
- my ( $self, $c, $path ) = @_;
-
- return if $self->SUPER::match( $c, $path );
-
- # Check path against plain text first
-
- foreach my $compiled ( @{ $self->_compiled } ) {
- if ( my @captures = ( $path =~ $compiled->{re} ) ) {
- next unless $compiled->{action}->match($c);
- $c->req->action( $compiled->{path} );
- $c->req->match($path);
- $c->req->captures( \@captures );
- $c->action( $compiled->{action} );
- $c->namespace( $compiled->{action}->namespace );
- return 1;
- }
- }
-
- return 0;
-}
-
-=head2 $self->register( $c, $action )
-
-Registers one or more regex actions for an action object.
-Also registers them as literal paths.
-
-Returns 1 if any regexps were registered.
-
-=cut
-
-sub register {
- my ( $self, $c, $action ) = @_;
- my $attrs = $action->attributes;
- my @register = @{ $attrs->{'Regex'} || [] };
-
- foreach my $r (@register) {
- $self->register_path( $c, $r, $action );
- $self->register_regex( $c, $r, $action );
- }
-
- return 1 if @register;
- return 0;
-}
-
-=head2 $self->register_regex($c, $re, $action)
-
-Register an individual regex on the action. Usually called from the
-register method.
-
-=cut
-
-sub register_regex {
- my ( $self, $c, $re, $action ) = @_;
- push(
- @{ $self->_compiled }, # and compiled regex for us
- {
- re => qr#$re#,
- action => $action,
- path => $re,
- }
- );
-}
-
-=head2 $self->uri_for_action($action, $captures)
-
-returns a URI for this action if it can find a regex attributes that contains
-the correct number of () captures. Note that this may function incorrectly
-in the case of nested captures - if your regex does (...(..))..(..) you'll
-need to pass the first and third captures only.
-
-=cut
-
-sub uri_for_action {
- my ( $self, $action, $captures ) = @_;
-
- if (my $regexes = $action->attributes->{Regex}) {
- REGEX: foreach my $orig (@$regexes) {
- my $re = "$orig";
- $re =~ s/^\^//;
- $re =~ s/\$$//;
- $re =~ s/\\([^\\])/$1/g;
- my $final = '/';
- my @captures = @$captures;
- while (my ($front, $rest) = split(/\(/, $re, 2)) {
- last unless defined $rest;
- ($rest, $re) =
- Text::Balanced::extract_bracketed("(${rest}", '(');
- next REGEX unless @captures;
- $final .= $front.shift(@captures);
- }
- $final .= $re;
- next REGEX if @captures;
- return $final;
- }
- }
- return undef;
-}
-
-=head1 AUTHORS
-
-Catalyst Contributors, see Catalyst.pm
-
-=head1 COPYRIGHT
-
-This library is free software. You can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
-
-__PACKAGE__->meta->make_immutable;
-
-1;
# See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
# Preload these action types
-our @PRELOAD = qw/Index Path Regex/;
+our @PRELOAD = qw/Index Path/;
# Postload these action types
our @POSTLOAD = qw/Default/;
+++ /dev/null
-#!perl
-
-use strict;
-use warnings;
-
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-
-our $iters;
-
-BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-
-use Test::More tests => 38*$iters;
-use Catalyst::Test 'TestApp';
-
-use Catalyst::Request;
-
-if ( $ENV{CAT_BENCHMARK} ) {
- require Benchmark;
- Benchmark::timethis( $iters, \&run_tests );
-}
-else {
- for ( 1 .. $iters ) {
- run_tests();
- }
-}
-
-sub run_tests {
- {
- ok( my $response = request('http://localhost/action/regexp/10/hello'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/(\d+)/(\w+)$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- like(
- $response->content,
- qr/^bless\( .* 'Catalyst::Request' \)$/s,
- 'Content is a serialized Catalyst::Request'
- );
- }
-
- {
- ok( my $response = request('http://localhost/action/regexp/hello/10'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/(\w+)/(\d+)$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- like(
- $response->content,
- qr/^bless\( .* 'Catalyst::Request' \)$/s,
- 'Content is a serialized Catalyst::Request'
- );
- }
-
- {
- ok( my $response = request('http://localhost/action/regexp/mandatory'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/(mandatory)(/optional)?$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- my $content = $response->content;
- my $req = eval $content;
-
- is( scalar @{ $req->captures }, 2, 'number of captures' );
- is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
- ok( !defined $req->captures->[ 1 ], 'optional capture' );
- }
-
- {
- ok( my $response = request('http://localhost/action/regexp/mandatory/optional'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/(mandatory)(/optional)?$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- my $content = $response->content;
- my $req = eval $content;
-
- is( scalar @{ $req->captures }, 2, 'number of captures' );
- is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
- is( $req->captures->[ 1 ], '/optional', 'optional capture' );
- }
-
- # test localregex in the root controller
- {
- ok( my $response = request('http://localhost/localregex'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^localregex$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Root',
- 'Test Class'
- );
- }
-
- {
- my $url = 'http://localhost/action/regexp/redirect/life/universe/42/everything';
- ok( my $response = request($url),
- 'Request' );
- ok( $response->is_redirect, 'Response is redirect' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/redirect/(\w+)/universe/(\d+)/everything$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- is(
- $response->header('location'),
- $response->request->uri,
- 'Redirect URI is the same as the request URI'
- );
- }
-}
-
use FindBin;
use lib "$FindBin::Bin/../lib";
-use Test::More tests => 28;
+use Test::More tests => 14;
use Catalyst::Test 'TestApp';
local $^W = 0;
my @tests = (
# Simple
- 'Regex vs. Local', { path => '/re_vs_loc', expect => 'local' },
- 'Regex vs. LocalRegex', { path => '/re_vs_locre', expect => 'regex' },
- 'Regex vs. Path', { path => '/re_vs_path', expect => 'path' },
- 'Local vs. LocalRegex', { path => '/loc_vs_locre', expect => 'local' },
'Local vs. Path 1', { path => '/loc_vs_path1', expect => 'local' },
'Local vs. Path 2', { path => '/loc_vs_path2', expect => 'path' },
- 'Path vs. LocalRegex', { path => '/path_vs_locre', expect => 'path' },
# index
- 'index vs. Regex', { path => '/re_vs_index', expect => 'index' },
'index vs. Local', { path => '/loc_vs_index', expect => 'index' },
- 'index vs. LocalRegex', { path => '/locre_vs_index', expect => 'index' },
'index vs. Path', { path => '/path_vs_index', expect => 'index' },
'multimethod zero', { path => '/multimethod', expect => 'zero' },
"no URI returned for Path action when snippets are given");
#
-# Regex Action
-#
-my $regex_action = $dispatcher->get_action_by_path(
- '/action/regexp/one'
- );
-
-ok(!defined($dispatcher->uri_for_action($regex_action)),
- "Regex action without captures returns undef");
-
-ok(!defined($dispatcher->uri_for_action($regex_action, [ 1, 2, 3 ])),
- "Regex action with too many captures returns undef");
-
-is($dispatcher->uri_for_action($regex_action, [ 'foo', 123 ]),
- "/action/regexp/foo/123",
- "Regex action interpolates captures correctly");
-
-my $regex_action_bs = $dispatcher->get_action_by_path(
- '/action/regexp/one_backslashes'
- );
-
-ok(!defined($dispatcher->uri_for_action($regex_action_bs)),
- "Regex action without captures returns undef");
-
-ok(!defined($dispatcher->uri_for_action($regex_action_bs, [ 1, 2, 3 ])),
- "Regex action with too many captures returns undef");
-
-is($dispatcher->uri_for_action($regex_action_bs, [ 'foo', 123 ]),
- "/action/regexp/foo/123.html",
- "Regex action interpolates captures correctly");
-
-
-#
# Index Action
#
my $index_action = $dispatcher->get_action_by_path(
ok(!defined($context->uri_for($path_action, [ 'blah' ])),
"no URI returned by uri_for for Path action with snippets");
-is($context->uri_for($regex_action, [ 'foo', 123 ], qw/bar baz/, { q => 1 }),
- "http://127.0.0.1/foo/action/regexp/foo/123/bar/baz?q=1",
- "uri_for correct for regex with captures, args and query");
-
is($context->uri_for($chained_action, [ 1 ], 2, { q => 1 }),
"http://127.0.0.1/foo/chained/foo/1/end/2?q=1",
"uri_for correct for chained with captures, args and query");
+++ /dev/null
-package TestApp::Controller::Action::Regexp;
-
-use strict;
-use base 'TestApp::Controller::Action';
-
-sub one : Action Regex('^action/regexp/(\w+)/(\d+)$') {
- my ( $self, $c ) = @_;
- $c->forward('TestApp::View::Dump::Request');
-}
-
-sub two : Action LocalRegexp('^(\d+)/(\w+)$') {
- my ( $self, $c ) = @_;
- $c->forward('TestApp::View::Dump::Request');
-}
-
-sub three : Action LocalRegex('^(mandatory)(/optional)?$'){
- my ( $self, $c ) = @_;
- $c->forward('TestApp::View::Dump::Request');
-}
-
-sub four : Action Regex('^action/regexp/redirect/(\w+)/universe/(\d+)/everything$') {
- my ( $self, $c ) = @_;
- $c->res->redirect(
- $c->uri_for($c->action, $c->req->captures,
- @{$c->req->arguments}, $c->req->params
- )
- );
-}
-
-sub one_backslashes : Action Regex('^action/regexp/(\w+)/(\d+)\.html$') {
- my ( $self, $c ) = @_;
- $c->forward('TestApp::View::Dump::Request');
-}
-
-1;
use base 'Catalyst::Controller';
#
-# Regex vs. Local
-#
-
-sub re_vs_loc_re :Regex('/priorities/re_vs_loc') { $_[1]->res->body( 'regex' ) }
-sub re_vs_loc :Local { $_[1]->res->body( 'local' ) }
-
-#
-# Regex vs. LocalRegex
-#
-
-sub re_vs_locre_locre :LocalRegex('re_vs_(locre)') { $_[1]->res->body( 'local_regex' ) }
-sub re_vs_locre_re :Regex('/priorities/re_vs_locre') { $_[1]->res->body( 'regex' ) }
-
-#
-# Regex vs. Path
-#
-
-sub re_vs_path_path :Path('/priorities/re_vs_path') { $_[1]->res->body( 'path' ) }
-sub re_vs_path_re :Regex('/priorities/re_vs_path') { $_[1]->res->body( 'regex' ) }
-
-#
-# Local vs. LocalRegex
-#
-
-sub loc_vs_locre_locre :LocalRegex('loc_vs_locre') { $_[1]->res->body( 'local_regex' ) }
-sub loc_vs_locre :Local { $_[1]->res->body( 'local' ) }
-
-#
# Local vs. Path (depends on definition order)
#
sub loc_vs_path2_loc :Path('/priorities/loc_vs_path2') { $_[1]->res->body( 'path' ) }
#
-# Path vs. LocalRegex
-#
-
-sub path_vs_locre_locre :LocalRegex('path_vs_(locre)') { $_[1]->res->body( 'local_regex' ) }
-sub path_vs_locre_path :Path('/priorities/path_vs_locre') { $_[1]->res->body( 'path' ) }
-
-#
-# Regex vs. index (has sub controller)
-#
-
-sub re_vs_idx :Regex('/priorities/re_vs_index') { $_[1]->res->body( 'regex' ) }
-
-#
# Local vs. index (has sub controller)
#
sub loc_vs_index :Local { $_[1]->res->body( 'local' ) }
#
-# LocalRegex vs. index (has sub controller)
-#
-
-sub locre_vs_idx :LocalRegex('locre_vs_index') { $_[1]->res->body( 'local_regex' ) }
-
-#
# Path vs. index (has sub controller)
#
+++ /dev/null
-package TestApp::Controller::Priorities::re_vs_index;
-
-use strict;
-use base 'Catalyst::Controller';
-
-sub index :Private { $_[1]->res->body( 'index' ) }
-
-1;
$c->res->body('');
}
-sub localregex : LocalRegex('^localregex$') {
- my ( $self, $c ) = @_;
- $c->res->header( 'X-Test-Class' => ref($self) );
- $c->response->content_type('text/plain; charset=utf-8');
- $c->forward('TestApp::View::Dump::Request');
-}
-
sub index : Private {
my ( $self, $c ) = @_;
$c->res->body('root index');
projects / catagits/Catalyst-Runtime.git / commitdiff