CGI-Application-Plugin-ActionDispatch-0.93/0000755000076500000240000000000010770076002017634 5ustar jaywhystaffCGI-Application-Plugin-ActionDispatch-0.93/Changes0000644000076500000240000000032410770076002021126 0ustar jaywhystaffRevision history for Perl extension CGI::Application::Plugin::ActionDispatch. 0.01 Tue Apr 4 12:02:13 2006 - original version; created by h2xs 1.23 with options -X CGI::Application::Plugin::ActionDispatch CGI-Application-Plugin-ActionDispatch-0.93/examples/0000755000076500000240000000000010770076002021452 5ustar jaywhystaffCGI-Application-Plugin-ActionDispatch-0.93/examples/testapp.cgi0000644000076500000240000000016110770076002023614 0ustar jaywhystaff#!/usr/bin/perl use lib './'; use TestApp; $ENV{PATH_INFO} = $ARGV[0]; my $app = TestApp->new(); $app->run(); CGI-Application-Plugin-ActionDispatch-0.93/examples/TestApp.pm0000644000076500000240000000112010770076002023362 0ustar jaywhystaffpackage TestApp; use base 'CGI::Application'; use lib '../lib'; use CGI::Application::Plugin::ActionDispatch; sub product : Regex('^/products/books/war_and_peace/(\d+)/') { my $self = shift; my $page_num = $self->action_args(); return "Runmode: product\nCategory: books\nProduct: war_and_peace\nArgs: $page_num\n"; } sub home : Default { return "Runmode: home\n"; } sub test : Runmode { my @args = $self->action_args(); return "Runmode: test\n"; } sub fail : Path('fail') { die "Call error mode"; } sub error_page : ErrorRunmode { return "Runmode: error_page\n"; } 1; CGI-Application-Plugin-ActionDispatch-0.93/lib/0000755000076500000240000000000010770076001020401 5ustar jaywhystaffCGI-Application-Plugin-ActionDispatch-0.93/lib/CGI/0000755000076500000240000000000010770076001021003 5ustar jaywhystaffCGI-Application-Plugin-ActionDispatch-0.93/lib/CGI/Application/0000755000076500000240000000000010770076001023246 5ustar jaywhystaffCGI-Application-Plugin-ActionDispatch-0.93/lib/CGI/Application/Plugin/0000755000076500000240000000000010770076002024505 5ustar jaywhystaffCGI-Application-Plugin-ActionDispatch-0.93/lib/CGI/Application/Plugin/ActionDispatch/0000755000076500000240000000000010770076002027402 5ustar jaywhystaffCGI-Application-Plugin-ActionDispatch-0.93/lib/CGI/Application/Plugin/ActionDispatch/._Attributes.pm0000644000076500000240000000027210770076034032311 0ustar jaywhystaffMac OS X  2ˆºATTRF„ͺ˜"˜"com.macromates.caret{ column = 22; line = 5; }CGI-Application-Plugin-ActionDispatch-0.93/lib/CGI/Application/Plugin/ActionDispatch/Attributes.pm0000644000076500000240000000405610770076034032100 0ustar jaywhystaffpackage CGI::Application::Plugin::ActionDispatch::Attributes; use attributes; use strict; our $VERSION = '0.02'; my @attributes; my %attr_handlers; my $init = 1; # MODIFY_CODE_ATTRIBUTES needs to be in the inheritance tree. push @CGI::Application::ISA, 'CGI::Application::Plugin::ActionDispatch::Attributes' unless grep /^CGI::Application::Plugin::ActionDispatch::Attributes$/, @CGI::Application::ISA; sub MODIFY_CODE_ATTRIBUTES { my($class, $code, @attrs) = @_; foreach (@attrs) { # Parse the attribute string ex: Regex('^/foo/bar/(\d+)/'). my($method, $params) = /^([a-z_]\w*)(?:[(](.*)[)])?$/is; $params =~ s/(^'|'$)//g if defined $params; # Attribute definition. if($method eq 'ATTR') { $attr_handlers{$code} = $params } # Is a custom attribute. else { my $handler = $class->can($method); next unless $handler; push(@attributes, [ $class, $method, $code, $params ] ); } } return (); } sub init { return unless $init; # Initialize only once foreach my $attr (@attributes) { my $class = $attr->[0]; my $method = $attr->[1]; # calls: class->method( code, method, params ); $class->$method( $attr->[2], $attr->[1], $attr->[3]); } $init = 0; } 1; __END__ =head1 NAME CGI::Application::Plugin::ActionDispatch::Attributes - Hidden attribute support for CGI::Application =head1 SYNOPSIS use CGI::Application::Plugin::ActionDispatch::Attributes; sub CGI::Application::Protected : ATTR { my( $package, $referent, $attr, $data ) = @_; ... } CGI::Application::Plugin::ActionDispatch::Attributes::init(); sub my_method Protected { ... } =head1 DESCRIPTION This module will add attribute support into CGI::Application. It will also not break mod_perl. T =head1 SEE ALSO =head1 AUTHOR Jason Yates, Ejaywhy@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006-2007 by Jason Yates This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut CGI-Application-Plugin-ActionDispatch-0.93/lib/CGI/Application/Plugin/._ActionDispatch.pm0000644000076500000240000000027210770076020030156 0ustar jaywhystaffMac OS X  2ˆºATTRF„κ˜"˜"com.macromates.caret{ column = 20; line = 7; }CGI-Application-Plugin-ActionDispatch-0.93/lib/CGI/Application/Plugin/ActionDispatch.pm0000644000076500000240000002001010770076020027731 0ustar jaywhystaffpackage CGI::Application::Plugin::ActionDispatch; use strict; use Class::Inspector; use CGI::Application::Plugin::ActionDispatch::Attributes; require Exporter; our $VERSION = '0.93'; our @ISA = qw(Exporter); our @EXPORT = qw(action_args); our %_attr_cache; my %methods; sub CGI::Application::Path :ATTR { my ($class, $referent, $attr, $data) = @_; $data ||=''; $data =~ s/\/$//; unless( $data =~ /^\// ) { $data = "/" . $data; } my $regex = qr/^$data\/?(\/.*)?$/; push(@{ $_attr_cache{$attr} }, [ $referent, $regex ]); } sub CGI::Application::Regex :ATTR { my ($package, $referent, $attr, $data) = @_; my $regex = qr/$data/; push(@{ $_attr_cache{$attr} }, [ $referent, $regex ]); } sub CGI::Application::Runmode :ATTR { my ($package, $referent, $attr, $data) = @_; $data = $methods{$referent}; my $regex = qr/^\/$data\/?$/; push(@{ $_attr_cache{$attr} }, [ $referent, $regex ]); } sub CGI::Application::Default :ATTR { my ($package, $referent, $attr, $data) = @_; $_attr_cache{$attr} = $referent; } sub CGI::Application::ErrorRunmode :ATTR { my ($package, $referent, $attr, $data) = @_; $_attr_cache{$attr} = $referent; } sub import { my $caller = caller; $caller->add_callback('init', \&_ad_init); $caller->add_callback('prerun', \&_ad_prerun); goto &Exporter::import; } sub _ad_init { my $self = shift; my $class = ref $self || $self; # Setup a hash table of all the methods in the class. $methods{$self->can($_)} = $_ foreach @{ Class::Inspector->methods($class) || [] }; #NOTE: This will search through ISA also. CGI::Application::Plugin::ActionDispatch::Attributes::init(); if(defined $_attr_cache{'Default'}) { my $runmode = $methods{$_attr_cache{'Default'}}; $self->start_mode($runmode); $self->run_modes($runmode => $runmode); } if(defined $_attr_cache{'ErrorRunmode'}) { $self->error_mode($methods{$_attr_cache{'ErrorRunmode'}}); } } sub _ad_prerun { my $self = shift; return unless defined $ENV{PATH_INFO}; my $start_mode = $self->start_mode(); ATTR: foreach my $type (qw( Runmode Regex Path )) { my($code, @args) = _match_type($type, $ENV{PATH_INFO}); if($code) { # Make sure the runmode isn't set already and prerun_mode isn't set. if(! $self->prerun_mode()) { # Sorta of a hack here to actually get the runmode to run. my $runmode = $methods{$code}; $self->run_modes($runmode => $runmode); $self->prerun_mode($runmode); # Set the action_args array. $self->action_args(@args); } last ATTR; } } } sub _match_type { my($type, $path_info) = @_; my $min; my(@path_args, $code); foreach my $attr (@{ $_attr_cache{$type} }) { if(my @args = ($path_info =~ $attr->[1])) { # We want to match the most accurate Path(). This is # done by counting the args, and finding the Path with # the fewest amount of args left over. if($type eq 'Path') { if(@args) { $args[0] =~ s/^\///; @path_args = split('/', $args[0]); } # Set min if not defined. $min = scalar(@path_args) if( not defined $min ); # If complete match return. if( scalar(@path_args) == 0 ) { return ($attr->[0], undef); } elsif(scalar(@path_args) <= $min) { # Has fewest @path_args so far. $min = scalar(@path_args); $code = $attr->[0]; } } else { return ($attr->[0], @args); } } } return @path_args ? ($code, @path_args) : 0; } sub action_args { my($self, @args) = @_; # If args are passed set them. if(@args) { $self->{__CAP_ACTION_ARGS} = [ @args ]; return; } return undef unless defined $self->{__CAP_ACTION_ARGS}; return wantarray ? @{$self->{__CAP_ACTION_ARGS}} : shift @{$self->{__CAP_ACTION_ARGS}}; } 1; __END__ =head1 NAME CGI::Application::Plugin::ActionDispatch - Perl extension =head1 SYNOPSIS # In "WebApp.pm"... package WebApp; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; sub do_stuff : Path('do/stuff') { ... } sub do_more_stuff : Regex('^/do/more/stuff\/?$') { ... } sub do_something_else : Regex('do/something/else/(\w+)/(\d+)$') { ... } =head1 DESCRIPTION CGI::Application::Plugin::ActionDispatch adds attribute based support for parsing the PATH_INFO of the incoming request. For those who are familiar with Catalyst. The interface works very similar. This plugin is plug and play and shouldn't interrupt the default behavior of CGI::Application. =head1 METHODS =over 4 =item action_args() If using capturing parentheses in a Regex action. The captured values are accessible using this method. sub addElement : Regex('add/(\d+)/(\d+)') { my $self = shift; my($column, $row) = $self->action_args(); ... } The Path action also stores the left over PATH_INFO. # http://example.com/state/pa/philadelphia sub find_state_and_city : Path('state/') { my $self = shift; my($state, $city) = $self->action_args(); ... } =back =head1 ACTIONS =over 4 =item Regex The Regex action is passed a regular expression. The regular expression is run on the PATH_INFO sent in the request. If capturing parentheses are used to extract parameters from the path. The parameters are accesssible using the action_args() method. Regex('^blah/foo'); The Regex action either matches or it doesn't. There are no secrets to it. It does however takes priority over the Path action. =item Path The Path action is basically a shortcut for a commonly used Regex action. # http://example.com/products/movies/2 sub show_product : Path('products/') { my $self = shift; my($category, $id) = $self->action_args(); .... } Is basically the same thing as. sub show_product : Regex('^/products/(\w+)/(\d+)') { my $self = shift; my($category, $id) = $self->action_args(); ... } For those that care, the Path('products/') will be converted to the regular expression "^/products\/?(\/.*)$". Then split('/') is run on the captured value and stored in action_args(). =item Runmode This attribute will take the method name and run a match on that. =item Default The default run mode if no match is found. Essentially the equivalent of the start_mode() method. =back =head1 EXAMPLE In CGI::Application module: package WebApp; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; use strict; sub setup { my $self = shift; self->mode_param('test_rm'); $self->run_modes( basic_runmode => 'basic_runmode' ); } # Regular runmodes should work. sub basic_runmode { my $self = shift } The product() runmode will match anything starting with "/products" in the PATH_INFO. # http://example.com/myapp.cgi/products/this/is/optional/and/stored/in/action_args/ sub product : Path('products/') { my $self = shift; my($category, $product) = $self->action_args(); } The music() runmode will match anything starting with "/products/music" in the PATH_INFO. The product() runmode also matches "/products/music". However since this runmode matches closer it takes priority over product(). # http://example.com/myapp.cgi/products/music/product/ sub music : Path('products/music/') { my $self = shift; my $product = $self->action_args(); ... } This beatles() runmode will match ONLY "/product/music/beatles" or "/product/music/beatles/". Regex takes priority over Path so the previous runmodes which match this PATH_INFO are not run. # http://example.com/myapp.cgi/products/music/beatles/ sub beatles : Regex('^/products/music/beatles\/?') { my $self = shift; ... } =head1 SEE ALSO L, L =head1 AUTHOR Jason Yates, Ejaywhy@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006-2007 by Jason Yates This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.7 or, at your option, any later version of Perl 5 you may have available. =cut CGI-Application-Plugin-ActionDispatch-0.93/Makefile.PL0000644000076500000240000000056710770076002021616 0ustar jaywhystaffuse ExtUtils::MakeMaker; WriteMakefile( NAME => 'CGI::Application::Plugin::ActionDispatch', VERSION_FROM => 'lib/CGI/Application/Plugin/ActionDispatch.pm', PREREQ_PM => { 'CGI::Application' => '4.0', 'Class::Inspector' => '0', 'Attribute::Handlers' => '0', }, INSTALLDIRS => 'site', PL_FILES => {} ); CGI-Application-Plugin-ActionDispatch-0.93/MANIFEST0000644000076500000240000000036210770076002020766 0ustar jaywhystaffChanges Makefile.PL MANIFEST README t/01_regex.t t/02_path.t t/03_default.t t/04_runmode.t t/05_match.t t/TestAppDefault.pm t/TestAppMatch.pm t/TestAppPath.pm t/TestAppRegex.pm t/TestAppRunmode.pm lib/CGI/Application/Plugin/ActionDispatch.pm CGI-Application-Plugin-ActionDispatch-0.93/README0000644000076500000240000001076110770076002020521 0ustar jaywhystaffNAME CGI::Application::Plugin::ActionDispatch - Perl extension SYNOPSIS # In "WebApp.pm"... package WebApp; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; sub do_stuff : Path('do/stuff') { ... } sub do_more_stuff : Regex('^/do/more/stuff\/?$') { ... } sub do_something_else : Regex('do/something/else/(\w+)/(\d+)$') { ... } DESCRIPTION CGI::Application::Plugin::ActionDispatch adds attribute based support for parsing the PATH_INFO of the incoming request. For those who are familiar with Catalyst. The interface works very similar. This plugin is plug and play and shouldn't interrupt the default behavior of CGI::Application. METHODS snippets() If using capturing parentheses in a Regex action. The captured values are accessible using this method. sub addElement : Regex('add/(\d+)/(\d+)') { my $self = shift; my($column, $row) = $self->snippets(); .... } The Path action also stores the left over PATH_INFO. # http://example.com/city/pa/philadelphia sub city : Path('city/') { my $self = shift; my($state, $city) = $self->snippets(); .... } ACTIONS Regex The Regex action is passed a regular expression. The regular expression is run on the PATH_INFO sent in the request. If capturing parentheses are used to extract parameters from the path. The parameters are accesssible using the snippets() method. Regex('^blah/foo'); The Regex action either matches or it doesn't. There are no secrets to it. It does however takes priority over the Path action. Path The Path action is basically a shortcut for a commonly used Regex action. sub list : Path('products/') { my $self = shift; my($category, $id) = $self->snippets(); .... } Is basically the same thing as. sub list : Regex('^/products/(\w+)/(\d+)') { my $self = shift; my($category, $id) = $self->snippets(); ... } For those that care, the Path('products/') will be converted to the regular expression "^/products\/?(\/.*)$". Then split('/') is run on the captured value and stored in snippets(). EXAMPLE In CGI::Application module: package WebApp; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; use strict; sub setup { my $self = shift; self->mode_param('test_rm'); $self->run_modes( basic_runmode => 'basic_runmode' ); } # Regular runmodes should work. sub basic_runmode { my $self = shift } The product() runmode will match anything starting with "/products" in the PATH_INFO. # http://example.com/myapp.cgi/products/this/is/optional/and/stored/in/snippets/ sub product : Path('products/') { my $self = shift; my($category, $product) = $self->snippets(); } The music() runmode will match anything starting with "/products/music" in the PATH_INFO. The product() runmode also matches "/products/music". However since this runmode matches closer it takes priority over product(). # http://example.com/myapp.cgi/products/music/product/ sub music : Path('products/music/') { my $self = shift; my $product = $self->snippets(); ... } This beatles() runmode will match ONLY "/product/music/beatles" or "/product/music/beatles/". Regex takes priority over Path so the previous runmodes which match this PATH_INFO are not run. # http://example.com/myapp.cgi/products/music/beatles/ sub beatles : Regex('^/products/music/beatles\/?') { my $self = shift; ... } SEE ALSO CGI::Application, CGI::Application::Dispatch, Attribute::Handlers AUTHOR Jason Yates, COPYRIGHT AND LICENSE Copyright (C) 2006 by Jason Yates This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.7 or, at your option, any later version of Perl 5 you may have available. CGI-Application-Plugin-ActionDispatch-0.93/t/0000755000076500000240000000000010770076002020077 5ustar jaywhystaffCGI-Application-Plugin-ActionDispatch-0.93/t/01_regex.t0000644000076500000240000000074210770076002021701 0ustar jaywhystaffuse Test::More tests => 6; use strict; use lib 't/'; BEGIN { use_ok('CGI::Application'); }; use TestAppRegex; use CGI; $ENV{CGI_APP_RETURN_ONLY} = 1; { local $ENV{PATH_INFO} = '/products/books/war_and_peace/ch/3/'; my $app = TestAppRegex->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: product/); like($output, qr/Category: books/); like($output, qr/Product: war_and_peace/); like($output, qr/Args: ch 3/); } CGI-Application-Plugin-ActionDispatch-0.93/t/02_path.t0000644000076500000240000000230610770076002021522 0ustar jaywhystaffuse Test::More tests => 13; use strict; use lib 't/'; BEGIN { use_ok('CGI::Application'); }; use TestAppPath; use CGI; $ENV{CGI_APP_RETURN_ONLY} = 1; { local $ENV{PATH_INFO} = '/products/music/rolling_stones/this/is/really/long/'; my $app = TestAppPath->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: test_rm/); like($output, qr/Args: this is really long/); } { local $ENV{PATH_INFO} = '/products/music/beatles/this/is/really/long/'; my $app = TestAppPath->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: test_rm_partial/); like($output, qr/Args: this is really long/); } { local $ENV{PATH_INFO} = '/products/music/miles_davis'; my $app = TestAppPath->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: test_rm_exact/); like($output, qr/Args: no args/); } { local $ENV{PATH_INFO} = '/products/music/miles_davis/'; my $app = TestAppPath->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: test_rm_exact/); like($output, qr/Args: no args/); } CGI-Application-Plugin-ActionDispatch-0.93/t/03_default.t0000644000076500000240000000041610770076002022213 0ustar jaywhystaffuse Test::More tests => 2; use strict; use lib 't/'; # 1 BEGIN { use_ok('CGI::Application'); }; use TestAppDefault; use CGI; $ENV{CGI_APP_RETURN_ONLY} = 1; { my $app = TestAppDefault->new(); my $output = $app->run(); like($output, qr/Runmode: default_rm/); } CGI-Application-Plugin-ActionDispatch-0.93/t/04_runmode.t0000644000076500000240000000054410770076002022243 0ustar jaywhystaffuse Test::More tests => 3; use strict; use lib 't/'; # 1 BEGIN { use_ok('CGI::Application'); }; use TestAppRunmode; use CGI; $ENV{CGI_APP_RETURN_ONLY} = 1; { local $ENV{PATH_INFO} = '/runmode_rm'; my $app = TestAppRunmode->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: runmode_rm/); } CGI-Application-Plugin-ActionDispatch-0.93/t/05_match.t0000644000076500000240000000312710770076002021667 0ustar jaywhystaffuse Test::More tests => 17; use strict; use lib 't/'; # 1 BEGIN { use_ok('CGI::Application'); }; use TestAppMatch; use CGI; $ENV{CGI_APP_RETURN_ONLY} = 1; { my $app = TestAppMatch->new(); $app->query(CGI->new({'test_rm' => 'basic_runmode'})); my $output = $app->run(); like($output, qr/Runmode: basic_runmode/); } { local $ENV{PATH_INFO} = ''; my $app = TestAppMatch->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: starter_rm/); } { local $ENV{PATH_INFO} = '/products'; my $app = TestAppMatch->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: products/); } { local $ENV{PATH_INFO} = '/products/'; my $app = TestAppMatch->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: products/); } { local $ENV{PATH_INFO} = '/products/books/war_and_peace'; my $app = TestAppMatch->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: product/); like($output, qr/Category: books/); like($output, qr/Product: war_and_peace/); } { local $ENV{PATH_INFO} = '/products/music/rolling_stones'; my $app = TestAppMatch->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: music/); like($output, qr/Product: rolling_stones/); } { local $ENV{PATH_INFO} = '/products/music/beatles'; my $app = TestAppMatch->new(); my $output = $app->run(); like($output, qr{^Content-Type: text/html}); like($output, qr/Runmode: beatles/); } CGI-Application-Plugin-ActionDispatch-0.93/t/06_errormode.t0000644000076500000240000000042510770076002022570 0ustar jaywhystaffuse Test::More tests => 2; use strict; use lib 't/'; # 1 BEGIN { use_ok('CGI::Application'); }; use TestAppErrorRunmode; use CGI; $ENV{CGI_APP_RETURN_ONLY} = 1; { my $app = TestAppErrorRunmode->new(); my $output = $app->run(); like($output, qr/Runmode: error_rm/); } CGI-Application-Plugin-ActionDispatch-0.93/t/TestAppDefault.pm0000644000076500000240000000053210770076002023322 0ustar jaywhystaffpackage TestAppDefault; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; @TestAppDefault::ISA = qw(CGI::Application); sub setup { my $self = shift; $self->run_modes({ home => 'home' }); } sub home { return "Runmode: home\n"; } sub default_rm : Default { my $self = shift; return "Runmode: default_rm\n"; } 1; CGI-Application-Plugin-ActionDispatch-0.93/t/TestAppErrorRunmode.pm0000644000076500000240000000061210770076002024360 0ustar jaywhystaffpackage TestAppErrorRunmode; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; @TestAppErrorRunmode::ISA = qw(CGI::Application); sub setup { my $self = shift; $self->run_modes({ home => 'home' }); } sub home : Default { die "Call error runmode"; return "Runmode: home\n"; } sub error_rm : ErrorRunmode { my $self = shift; return "Runmode: error_rm\n"; } 1; CGI-Application-Plugin-ActionDispatch-0.93/t/TestAppMatch.pm0000644000076500000240000000161210770076002022772 0ustar jaywhystaffpackage TestAppMatch; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; @TestApp::ISA = qw(CGI::Application); sub setup { my $self = shift; $self->mode_param('test_rm'); $self->run_modes( basic_runmode => 'basic_runmode' ); } sub basic_runmode { my $self = shift; return "Runmode: basic_runmode\n"; } sub starter_rm : Default { return "Runmode: starter_rm\n"; } sub products : Runmode { my $self = shift; return "Runmode: products\n"; } sub product : Path('products/') { my $self = shift; my($category, $product) = $self->action_args(); return "Runmode: product\nCategory: $category\nProduct: $product\n"; } sub music : Path('products/music/') { my $self = shift; my $product = $self->action_args(); return "Runmode: music\nProduct: $product\n"; } sub beatles : Regex('^/products/music/beatles\/?') { my $self = shift; return "Runmode: beatles\n"; } CGI-Application-Plugin-ActionDispatch-0.93/t/TestAppPath.pm0000644000076500000240000000130710770076002022633 0ustar jaywhystaffpackage TestAppPath; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; @TestApp::ISA = qw(CGI::Application); sub test_rm : Path('/products/music/rolling_stones/') { my $self = shift; my( @args ) = $self->action_args(); return "Runmode: test_rm\nArgs: " . join(" ", @args); } sub test_rm_exact : Path('products/music/miles_davis') { my $self = shift; my @args = $self->action_args(); my $return = join(" ", @args) if @args; return "Runmode: test_rm_exact\nArgs: " . $return . "no args"; } sub test_rm_partial : Path('products/music/beatles') { my $self = shift; my( @args ) = $self->action_args(); return "Runmode: test_rm_partial\nArgs: " . join(" ", @args); } CGI-Application-Plugin-ActionDispatch-0.93/t/TestAppRegex.pm0000644000076500000240000000054310770076002023012 0ustar jaywhystaffpackage TestAppRegex; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; @TestApp::ISA = qw(CGI::Application); sub product : Regex('^/products/books/war_and_peace/(\w+)/(\d+)/') { my $self = shift; my($ch, $num) = $self->action_args(); return "Runmode: product\nCategory: books\nProduct: war_and_peace\nArgs: $ch $num\n"; } CGI-Application-Plugin-ActionDispatch-0.93/t/TestAppRunmode.pm0000644000076500000240000000035010770076002023345 0ustar jaywhystaffpackage TestAppRunmode; use base 'CGI::Application'; use CGI::Application::Plugin::ActionDispatch; @TestAppRunmode::ISA = qw(CGI::Application); sub runmode_rm : Runmode { my $self = shift; return "Runmode: runmode_rm\n"; } 1;