CGI-Application-Plugin-AutoRunmode-0.18/0000755000473500001440000000000011527434524017054 5ustar thilousersCGI-Application-Plugin-AutoRunmode-0.18/Changes0000644000473500001440000000522611527434267020360 0ustar thilousersRevision history for Perl extension CGI::Application::Plugin::AutoRunmode. 0.18 Fri Feb 18 2011 - add support for multiple directories in FileDelegate, suggested by Jiří Pavlovský (see CPAN RT #65695: support multiple directories in FileDelegate) 0.17 Fri Mar 21 2010 - fix support for Apache2::Reload (the changes in 0.16 did not work) (see CPAN RT #35987: StartRunmode dies with Apache2::Reload) 0.16 Sat Feb 14 2009 - :ErrorRunmode is no longer registered as a "real" runmode (see CPAN RT #36706: [patch] ErrorRunmode should not create a run mode) - support for Apache2::Reload (see CPAN RT #35987: StartRunmode dies with Apache2::Reload) 0.15 Sun Dec 17 2006 - added :ErrorRunmode (proposed by Robert Hicks) 0.14 Sun May 21 2006 - fix for the Attribute::Handlers/mod_perl problems (stop relying on code being executed in the CHECK phase, which is problematic in mod_perl, use BEGIN instead) 0.13 Sat Apr 8 2006 - put the :Runmodes directly in the run_modes map (only for CGI::App >= 4 and using Attribute::Handlers) - make FileDelegate compatible with Taint mode 0.12 Thu Nov 3 2005 - support for multiple delegates, based on a patch submitted by Larry Leszczynski 0.11 Tue Oct 18 2005 - applied a patch by Cees Hek to fix problems with subclassing introduced with 0.10 0.10 Sat Oct 15 2005 - use Attribute::Handlers when available to improve interoperability with other modules that want to define attributes (thanks to Cees Hek for feedback on this) 0.09 Wed Sep 21 2005 - is_auto_runmode (proposed by Michael Graham for interoperability with CAP::Forward) 0.08 Sat Jul 17 2005 - :StartRunmode - attribute names are now case-insensitive - documentation patches (thanks to Mark Stosberg) 0.07 Sat Jun 18 2005 - removed Mac OS X meta data files that confused the build system (see http://perlmonks.org/?node_id=467916 ) - changed links to CGI::App wiki in the documentation 0.06 Wed Jun 15 2005 - replaced CGI::Application::Callbacks with official hook system provided by CGI::App version 4 - removed Perl 5.8.1 requirement 0.05 Thu Mar 10 2005 - no longer install Runmode attribute handler into CGI::App, but export into caller's namespace - added FileDelegate 0.04 Fri Mar 04 2005 - security fix: disallow non-word characters in runmode name 0.03 Thu Mar 03 2005 - support for runmode delegates 0.02 Fri Oct 29 2004 - support for CGI::Application::Callbacks - support for prerun_mode() 0.01 Sat Oct 16 18:15:03 2004 - original version; created by h2xs 1.22 with options -AX -n CGI::Application::Plugin::AutoRunmode CGI-Application-Plugin-AutoRunmode-0.18/META.yml0000644000473500001440000000055211527434524020327 0ustar thilousers# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: CGI-Application-Plugin-AutoRunmode version: 0.18 version_from: AutoRunmode.pm installdirs: site requires: CGI::Application: 3 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 CGI-Application-Plugin-AutoRunmode-0.18/Makefile.PL0000644000473500001440000000110111527434267021023 0ustar thilousersuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'CGI::Application::Plugin::AutoRunmode', VERSION_FROM => 'AutoRunmode.pm', # finds $VERSION PREREQ_PM => { 'CGI::Application' => 3, }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'AutoRunmode.pm', # retrieve abstract from module AUTHOR => 'Thilo Planz ') : ()), ); CGI-Application-Plugin-AutoRunmode-0.18/MANIFEST0000644000473500001440000000061311527434267020211 0ustar thilousersAutoRunmode.pm AutoRunmode/FileDelegate.pm Changes Makefile.PL MANIFEST README t/1.t t/delegate.t t/file_delegate.t t/runmodes/mode1.pl t/startrunmode.t t/is_auto_runmode.t t/is_delegate_auto_runmode.t t/attribute_handlers.t t/error_runmode.t t/apache2_reload.t t/mocklibs/Apache2/Reload.pm t/runmodes/sub/submode.pl META.yml Module meta-data (added by MakeMaker) CGI-Application-Plugin-AutoRunmode-0.18/AutoRunmode/0000755000473500001440000000000011527434524021316 5ustar thilousersCGI-Application-Plugin-AutoRunmode-0.18/AutoRunmode/FileDelegate.pm0000644000473500001440000000637611527434267024206 0ustar thilouserspackage CGI::Application::Plugin::AutoRunmode::FileDelegate; use strict; use Carp; our $VERSION = '0.18'; sub new{ my ($pkg, @directories) = @_; foreach my $directory (@directories){ # keep taint-mode happy where ./ is not in @INC $directory = "./$directory" unless (index ($directory, '/') == 0); # check if the directory exists croak "$directory is not a directory" unless -d $directory; } return bless \@directories, $pkg; } sub can{ my($self, $name) = @_; # check the directories foreach (@$self){ if (-e "$_/$name.pl"){ my $can = do "$_/$name.pl"; if ($@ or $!){ croak "could not evaluate runmode in file $_/$name.pl: $@ $!"; } return $can if ref $can eq 'CODE'; croak "runmode file $_/$name.pl did not return a subroutine reference"; } } return UNIVERSAL::can($self, $name); } 1; __END__ =head1 NAME CGI::Application::Plugin::AutoRunmode::FileDelegate - delegate CGI::App run modes to a directory of files =head1 SYNOPSIS # in file runmodes/my_run_mode.pl sub { my ($app, $delegate) = @_; # do something here }; # in file runmodes/another_run_mode.pl sub { # do something else }; package MyApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun]; use CGI::Application::Plugin::AutoRunmode::FileDelegate(); sub setup{ my ($self) = @_; my $delegate = new CGI::Application::Plugin::AutoRunmode::FileDelegate ('/path/to/runmodes') $self->param('::Plugin::AutoRunmode::delegate' => $delegate); } # you now have two run modes # "my_run_mode" and "another_run_mode" =head1 DESCRIPTION Using this module, you can place the definition of your run modes for a CGI::Application into directory of files (as opposed to into a Perl module). Each run mode is contained in its own file, named foo.pl for a run mode called foo. The run modes are lazily evaluated (on demand) for each request. In the case of mod_perl this means you can update them without restarting your web server. In the case of plain CGI it means a reduced startup cost if you have many run modes (because only the one that you need gets parsed and loaded, along with dependent modules). =head2 Using more than one directory with runmodes You can pass multiple directory paths to the constructor for the delegate: my $delegate = new CGI::Application::Plugin::AutoRunmode::FileDelegate ('/path/to/runmodes', '/path/to/more_runmodes') In this case, they will be searched in order. The first matching file becomes the run mode. In the case of errors with that file, the module will croak (and not continue the search in the remaining directories). =head1 BUGS With all the namespace nesting going on the name of this module has reached an intolerable Java-esque length. =head1 SEE ALSO If you like the idea of moving everything outside of Perl modules into seperate files, you should also have a look at L, which does a similar thing for HTML templates and the Perl code needed to provide them with data. =head1 AUTHOR Thilo Planz, Ethilo@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright 2005 by Thilo Planz This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut CGI-Application-Plugin-AutoRunmode-0.18/AutoRunmode.pm0000644000473500001440000003531311527434267021665 0ustar thilouserspackage CGI::Application::Plugin::AutoRunmode; use strict; require Exporter; require CGI::Application; use Carp; our $VERSION = '0.18'; our %RUNMODES = (); # two different versions of this module, # depending on whether Attribute::Handlers is # available my $has_ah; BEGIN{ eval 'use Attribute::Handlers; $has_ah=1;'; if ($has_ah){ $has_ah = eval <<'WITH_AH'; # run this handler twice: # in CHECK when we have the name, and also in BEGIN # (because CHECK does not seem to work in mod_perl) sub CGI::Application::Runmode :ATTR(CODE,BEGIN,CHECK) { my ( $pkg, $glob, $ref, $attr, $data, $phase ) = @_; no strict 'refs'; $RUNMODES{"$ref"} = 1; if ($CGI::Application::VERSION >= 4 && $phase eq 'CHECK'){ # also install the init-hook to register # named runmodes my $name = *{$glob}{NAME}; if ($name ne 'ANON'){ $pkg->add_callback('init', sub{ $_[0]->run_modes( $name => $ref ) if ($_[0]->can($name)) eq $ref } ) } } } sub CGI::Application::StartRunmode :ATTR(CODE,BEGIN) { my ( $pkg, $glob, $ref, $attr, $data, $phase ) = @_; install_start_mode($pkg, $ref); } sub CGI::Application::ErrorRunmode :ATTR(CODE,BEGIN) { my ( $pkg, $glob, $ref, $attr, $data, $phase ) = @_; install_error_mode($pkg, $ref); } # the Attribute::Handler version still exports a MODIFY_CODE_ATTRIBUTES # but only to provide backwards compatibility (case-independent attribute # names ) sub MODIFY_CODE_ATTRIBUTES{ my ($pkg, $ref, @attr) = @_; foreach (@attr){ if (uc $_ eq 'RUNMODE'){ $_ = 'Runmode'; next; } if (uc $_ eq 'STARTRUNMODE'){ $_ = 'StartRunmode'; next; } if (uc $_ eq 'ERRORRUNMODE'){ $_ = 'ErrorRunmode'; next; } } return $pkg->SUPER::MODIFY_CODE_ATTRIBUTES($ref, @attr); } 1; WITH_AH warn "failed to load Attribute::Handlers version of CAP:AutoRunmode $@" if $@; } unless ($has_ah){ eval <<'WITHOUT_AH' or die $@; sub MODIFY_CODE_ATTRIBUTES{ my ($pkg, $ref, @attr) = @_; my @unknown; foreach (@attr){ my $u = uc $_; $CGI::Application::Plugin::AutoRunmode::RUNMODES{"$ref"} = 1, next if $u eq 'RUNMODE'; if ($u eq 'STARTRUNMODE'){ install_start_mode($pkg, $ref); next; } if ($u eq 'ERRORRUNMODE'){ install_error_mode($pkg, $ref); next; } push @unknown, $_; } return @unknown; } 1; WITHOUT_AH } } our @ISA = qw(Exporter); # always export the attribute handlers sub import{ __PACKAGE__->export_to_level(1, @_, 'MODIFY_CODE_ATTRIBUTES'); # if CGI::App > 4 install the hook # (unless cgiapp_prerun requested) if ( @_ < 2 and $CGI::Application::VERSION >= 4 ){ my $caller = scalar(caller); if (UNIVERSAL::isa($caller, 'CGI::Application')){ $caller->add_callback('prerun', \&cgiapp_prerun); } } }; our @EXPORT_OK = qw[ cgiapp_prerun MODIFY_CODE_ATTRIBUTES ]; our %__illegal_names = qw[ can can isa isa VERSION VERSION AUTOLOAD AUTOLOAD new new DESTROY DESTROY ]; sub cgiapp_prerun{ my ($self, $rm) = @_; my %rmodes = ($self->run_modes()); # If prerun_mode has been set, use it! my $prerun_mode = $self->prerun_mode(); if (length($prerun_mode)) { $rm = $prerun_mode; } return unless defined $rm; unless (exists $rmodes{$rm}){ # security check / untaint : disallow non-word characters if ($rm =~ /^(\w+)$/){ $rm = $1; # check :Runmodes $self->run_modes( $rm => $rm), return if is_attribute_auto_runmode($self, $rm); # check delegate my $sub = is_delegate_auto_runmode($self, $rm); $self->run_modes( $rm => $sub) if $sub; } } } sub install_start_mode{ my ($pkg, $ref) = @_; no strict 'refs'; if (defined *{"${pkg}::start_mode"}){ if ($ENV{MOD_PERL} && exists $INC{'Apache2/Reload.pm'}){ # be lenient with Apache2::Reload # see https://rt.cpan.org/Ticket/Display.html?id=35987 }else{ die "StartRunmode for package $pkg is already installed\n"; } } my $memory; #if (ref $ref eq 'GLOB') { # $memory = *{$ref}{NAME}; # $ref = *{$ref}{CODE}; #} $RUNMODES{"$ref"} = 1; no warnings 'redefine'; *{"${pkg}::start_mode"} = sub{ return if @_ > 1; return $memory if $memory; return $memory = _find_name_of_sub_in_pkg($ref, $pkg); }; } sub install_error_mode{ my ($pkg, $ref) = @_; no strict 'refs'; if ( defined *{"${pkg}::error_mode"}){ if ($ENV{MOD_PERL} && exists $INC{'Apache2/Reload.pm'}){ # be lenient with Apache2::Reload # see https://rt.cpan.org/Ticket/Display.html?id=35987 }else{ die "ErrorRunmode for package $pkg is already installed\n"; } } my $memory; #if (ref $ref eq 'GLOB') { # $memory = *{$ref}{NAME}; # $ref = *{$ref}{CODE}; #} no warnings 'redefine'; *{"${pkg}::error_mode"} = sub{ return if @_ > 1; return $memory if $memory; return $memory = _find_name_of_sub_in_pkg($ref, $pkg); }; } # code for this inspired by Devel::Symdump sub _find_name_of_sub_in_pkg{ my ($ref, $pkg) = @_; no strict 'refs'; #return *{$ref}{NAME} if ref $ref eq 'GLOB'; while (my ($key,$val) = each(%{*{"$pkg\::"}})) { local(*ENTRY) = $val; if (defined $val && defined *ENTRY{CODE}) { next unless *ENTRY{CODE} eq $ref; # rewind "each" my $a = scalar keys %{*{"$pkg\::"}}; return $key; } } die "failed to find name for StartRunmode code ref $ref in package $pkg\n"; } sub is_attribute_auto_runmode{ my($app, $rm) = @_; my $sub = $app->can($rm); return unless $sub; return $sub if $RUNMODES{"$sub"}; # also check the GLOB #if ($has_ah){ # no strict 'refs'; # my $pkg = ref $app; # warn "${pkg}::${rm}"; # use Data::Dumper; # warn Dumper \%RUNMODES; # return $sub if $RUNMODES{*{"${pkg}::${rm}"}}; #} return undef; } sub is_delegate_auto_runmode{ my($app, $rm) = @_; my $delegate = $app->param('::Plugin::AutoRunmode::delegate'); return unless $delegate; return if exists $__illegal_names{$rm}; my @delegates = ref($delegate) eq 'ARRAY' ? @$delegate : ($delegate); foreach my $delegate (@delegates) { my $sub = $delegate->can($rm); next unless $sub; # construct a closure, as we need a second # parameter (the delegate) my $closure = sub { $sub->($_[0], $delegate); }; return $closure; } } sub is_auto_runmode{ return is_attribute_auto_runmode(@_) || is_delegate_auto_runmode(@_); } 1; __END__ =head1 NAME CGI::Application::Plugin::AutoRunmode - CGI::App plugin to automatically register runmodes =head1 SYNOPSIS Using subroutine attributes: package MyApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode; sub my_run_mode : StartRunmode { # do something here } sub another_run_mode : Runmode { # do something else } # you now have two run modes # "my_run_mode" and "another_run_mode" # "my_run_mode" is the start (default) run mode Declare that every method in a (delegate) class is a run mode. package MyAppRunmodes; # the delegate class sub my_run_mode { my ($app, $delegate) = @_; # do something here } sub another_run_mode { # do something else } package MyApp; use base 'CGI::Application'; sub setup{ my ($self) = @_; my $delegate = 'MyAppRunmodes'; # $delegate can be a class name or an object $self->param('::Plugin::AutoRunmode::delegate' => $delegate); } # you now have two run modes # "my_run_mode" and "another_run_mode" =head1 DESCRIPTION This plugin for CGI::Application provides easy ways to setup run modes. You can just write the method that implement a run mode, you do not have to explicitly register it with CGI::App anymore. There are two approaches: =over 4 =item Declare run modes with subroutine attributes. You can flag methods in your CGI::App subclass with the attribute "Runmode" or "StartRunmode" (these attributes are case-insensitive) =item Declare that every method in a class is a run mode. You can assign a delegate object, all whose methods will become runmodes You can also mix both approaches. Delegate runmodes receive two parameters: The first one is the CGI::App instance, followed by the delegate instance or class name. This can be useful if you have delegate objects that contain state. It is possible to chain multiple delegates by specifying an array reference containing the delegate instances or class names. This chain is checked from left to right and the runmode will be delegated to the first match. =back It both cases, the resulting runmodes will have the same name as the subroutine that implements them. They are activated by a cgiapp_prerun hook provided by this plugin (if you are using CGI::Application older than version 4, hooks are not available, and you can import a cgiapp_prerun method instead). =head2 EXPORT This module needs to export some symbols to do its job. First of all, there are the handlers for the Runmode attribute. In addition to that, the cgiapp_prerun hook is installed in your application class. This is not done as an export per se, but the hook installation is still done in the import subroutine. Sound confusing, is confusing, but you do not really need to know what is going on exactly, just keep in mind that in order to let things go on, you have to "use" the module with the default exports: use CGI::Application::Plugin::AutoRunmode; and not use CGI::Application::Plugin::AutoRunmode (); # this will disable the Runmode attributes # DO NOT DO THIS You can also explicitly import the cgiapp_prerun method. This will disable the installation of the hook. Basically, you only want to do this if you are using CGI::Application prior to version 4, where hooks are not supported. use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun]; # do this if you use CGI::Application version 3.x =head2 How does it work? After CGI::App has determined the name of the run mode to be executed in the normal way, cgiapp_prerun checks if such a run mode exists in the map configured by $self->run_modes(). If the run mode already exists, it gets executed normally (this module does nothing). This means that you can mix the ways to declare run modes offered by this plugin with the style provided by core CGI::App. If that is not the case, it tries to find a method of the same name in the application class (or its superclasses) that has been flagged as a Runmode. If it finds one, it augments the mapping with a subroutine reference to that method. If that step fails, it looks if a delegate has been defined and searches the methods of that delegate object for one that matches the name of the runmode. The runmode can then be executed by CGI::App as if it had been set up by $self->run_modes() in the first place. =head3 The run mode called "start" Note that because the plugin only gets activated when you call a run mode that is not registered in the usual run mode map, you cannot use it to create a run mode called C<< start >>. The CGI:App base class always registers a run mode of that name. =head2 Does it still work if I change the run mode in cgiapp_prerun ? If you have a cgiapp_prerun method and change the run mode there, the installed hook will not be able to catch it (because of the ordering of hooks). So, if you do that, you have to explicitly make this call before returning from cgiapp_prerun: CGI::Application::Plugin::AutoRunmode::cgiapp_prerun($self); Again, this is only necessary if you change the run mode (to one that needs the auto-detection feature). Also, this kind of code can be used with CGI::App 3.x if you have a cgiapp_prerun. =head2 StartRunmode The attribute StartRunmode designates that subroutine to be the start (default) run mode. If you use this feature, the "traditional" way of setting the start run mode (calling C<< $self->start_mode('name') >>) is disabled and can no longer be used in this application (including subclasses and instance scripts). =head2 ErrorRunmode The attribute ErrorRunmode designates that subroutine to be the error run mode. If you use this feature, the "traditional" way of setting the error run mode (calling C<< $self->error_mode('name') >>) is disabled and can no longer be used in this application (including subclasses and instance scripts). This feature requires CGI::App of at least version 3.30. Note that this "error run mode" is not a run mode that is directly accessible using its name as a query parameter. It will only be dispatched to internally if the original run mode produced an error. This is exactly how plain CGI:App C<< error_mode >> behaves as well (you could still declare the method to also be a C<< :Runmode >> ). =head2 A word on security The whole idea of this module (to reduce code complexity by automatically mapping a URL to a subroutine that gets executed) is a potential security hazard and great care has to be taken so that a remote user cannot run code that you did not intend them to. In order to prevent a carefully crafted URL to access code in other packages, this module disallows non-word characters (such as : ) in run mode names. Also, you have to make sure that when using a delegate object, that it (and its superclasses) only contain run modes (and no other subroutines). The following run mode names are disallowed by this module: can isa VERSION AUTOLOAD new DESTROY =head2 Effect on the run_modes map This module only inserts the current run mode into the run_mode map (unless it is already in there). It does not place any other :Runmodes there. As a result of this behaviour, users of AutoRunmode will most likely find the run mode map almost completely empty. This can lead to strange results if you expect a more complete list of possible run modes there. At this time, there is no workaround for this. Feel free to complain to the author if you have a requirement here. It is possible, however, to query the AutoRunmode plugin if an AutoRunmode exists for a given name. my $check = CGI::Application::Plugin::AutoRunmode::is_auto_runmode($self, $name) This function returns a code ref if such an AutoRunmode exists. =head1 SEE ALSO =over =item * L =item * L =item * The CGI::App wiki at L. =item * L provides an alternative set of attributes that dispatch according to PATH_INFO. It is very similar to the mechanism used in the Catalyst framework. =back =head1 AUTHOR Thilo Planz, Ethilo@cpan.orgE =head1 SUPPORT Please use the request tracker at CPAN to report bugs or feature requests: L If you want to support the development of this module with money, you can donate using Flattr: L =head1 COPYRIGHT AND LICENSE Copyright 2004-2011 by Thilo Planz This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut CGI-Application-Plugin-AutoRunmode-0.18/README0000644000473500001440000000200211527434267017732 0ustar thilousersCGI/Application/Plugin/AutoRunmode version 0.18 =============================================== This plugin for CGI::Application provides easy ways to setup run modes. You can just write the methods that implement a run mode, you do not have to explicitly register it with CGI::App anymore. There are two approaches: You can flag methods in your CGI::App subclass with the attribute "Runmode", or you can assign a delegate object, all whose methods will become runmodes (you can also mix both approaches). A third approach is to use a delegate object that delegates to Perl source files on disk, an implementation of which is included herein. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: CGI::Application COPYRIGHT AND LICENCE Copyright (C) 2004-2011 Thilo Planz This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. CGI-Application-Plugin-AutoRunmode-0.18/t/0000755000473500001440000000000011527434524017317 5ustar thilousersCGI-Application-Plugin-AutoRunmode-0.18/t/mocklibs/0000755000473500001440000000000011527434524021122 5ustar thilousersCGI-Application-Plugin-AutoRunmode-0.18/t/mocklibs/Apache2/0000755000473500001440000000000011527434524022365 5ustar thilousersCGI-Application-Plugin-AutoRunmode-0.18/t/mocklibs/Apache2/Reload.pm0000644000473500001440000000006611527434267024137 0ustar thilouserspackage Apache2::Reload; $ENV{MOD_PERL} = 'fake'; 1;CGI-Application-Plugin-AutoRunmode-0.18/t/runmodes/0000755000473500001440000000000011527434524021153 5ustar thilousersCGI-Application-Plugin-AutoRunmode-0.18/t/runmodes/mode1.pl0000644000473500001440000000034511527434267022523 0ustar thilouserssub { my ($self, $delegate) = @_; die "expected CGI::App instance as first parameter" unless $self->isa('CGI::Application'); die "expected delegate class or instance as second parameter" unless $delegate; 'called mode1'; }; CGI-Application-Plugin-AutoRunmode-0.18/t/runmodes/sub/0000755000473500001440000000000011527434524021744 5ustar thilousersCGI-Application-Plugin-AutoRunmode-0.18/t/runmodes/sub/submode.pl0000644000473500001440000000034711527434267023747 0ustar thilouserssub { my ($self, $delegate) = @_; die "expected CGI::App instance as first parameter" unless $self->isa('CGI::Application'); die "expected delegate class or instance as second parameter" unless $delegate; 'called submode'; }; CGI-Application-Plugin-AutoRunmode-0.18/t/1.t0000644000473500001440000000567511527434267017665 0ustar thilousers#!perl -T # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' ######################### use Test::More tests => 9; BEGIN { use_ok('CGI::Application::Plugin::AutoRunmode') }; ######################### # Test CGI::App class { package MyTestApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun ]; sub mode1 : Runmode { 'called mode1'; } sub not_a_runmode{ 'not a runmode'; } } $ENV{CGI_APP_RETURN_ONLY} = 1; $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = 'rm=mode1'; use CGI; my $q = new CGI; { my $testname = "autodetect runmode in CGI::App class"; my $app = new MyTestApp(QUERY=>$q); my $t = $app->run; ok ($t =~ /called mode1/, $testname); } { package MyTestAppCased; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun ]; sub mode1 : RunMode { 'called mode1'; } sub not_a_runmode{ 'not a runmode'; } } { my $testname = "case insensitivity"; my $app = new MyTestAppCased(QUERY=>$q); my $t = $app->run; ok ($t =~ /called mode1/, $testname); } { my $testname = "try to call a not-runmode"; $q->param(rm => 'not_a_runmode'); my $app = new MyTestApp(QUERY=>$q); eval{ my $t = $app->run; }; ok ($@ =~ /not_a_runmode/, $testname); } # Test CGI::App subclass { package MyTestSubApp; use base qw[MyTestApp ]; sub mode2 : Runmode { 'called mode2'; } } # Callback test package { package MyCallBackTest; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode; sub mode2 : Runmode { 'called mode2'; } sub cgiapp_prerun{ my ($self, $rm) = @_; $self->prerun_mode('mode2') if $rm eq 'change_to_2'; CGI::Application::Plugin::AutoRunmode::cgiapp_prerun($self); } } { my $testname = "runmode from a superclass"; $q->param(rm => 'mode1'); my $app = new MyTestSubApp(QUERY=>$q); my $t = $app->run; ok ($t =~ /called mode1/, $testname); } { my $testname = "runmode from a subclass"; $q->param(rm => 'mode2'); my $app = new MyTestSubApp(QUERY=>$q); my $t = $app->run; ok ($t =~ /called mode2/, $testname); } { my $testname = "security check - calling packaged runmode"; $q->param(rm => 'MyTestSubApp::mode2'); my $app = new MyTestApp(QUERY=>$q); eval{ my $t = $app->run; }; ok ($@ =~ /^No such/, $testname); } # CGI::App::Callbacks tests (4.0 hooks) SKIP: { my $has_callbacks = $CGI::Application::VERSION >= 4; skip 'callback hooks require CGI::Application version 4', 2 unless $has_callbacks; { my $testname = "install via Callbacks"; $q->param(rm => 'mode2'); my $app = new MyCallBackTest(QUERY=>$q); my $t = $app->run; ok ($t =~ /called mode2/, $testname); } { my $testname = "prerun changed mode"; $q->param(rm => 'change_to_2'); my $app = new MyCallBackTest(QUERY=>$q); my $t = $app->run; ok ($t =~ /called mode2/, $testname); } }; # end skip CGI-Application-Plugin-AutoRunmode-0.18/t/startrunmode.t0000644000473500001440000000367611527434267022253 0ustar thilousers#!perl -T use Test::More tests => 6; use strict; use warnings; BEGIN { use_ok('CGI::Application::Plugin::AutoRunmode') }; $ENV{CGI_APP_RETURN_ONLY} = 1; { package MyTestApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun ]; # for CGI::App 3 compatibility sub mode1 : StartRunmode { 'called mode1'; } sub mode2 { 'called mode2 in the super class' } } { package MyTestSubApp; use base 'MyTestApp'; sub mode2 : StartrunMode { 'called mode2 in the sub class'; } } { package MyTestSubAppWithStartCalledStart; use base 'MyTestApp'; sub start : StartrunMode { 'called start mode called start'; } } { my $testname = "autodetect startrunmode "; my $app = new MyTestApp(); my $t = $app->run; ok ($t =~ /called mode1/, $testname); } { my $testname = "autodetect startrunmode in subclass and case-insensitive "; my $app = new MyTestSubApp(); my $t = $app->run; ok ($t =~ /called mode2 in the sub class/, $testname); } { my $testname = "cannot install two StartRunmodes "; eval <<'CODE'; package MyTestAppBroken; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode; sub mode1 : StartRunmode { 'called mode1'; } sub mode2 : StartRunmode { 'called mode2'; } CODE ok ($@ =~ /StartRunmode for package MyTestAppBroken is already installed/, $testname); } TODO: { { my $testname = "autodetect startrunmode called start"; local $TODO = 'you cannot have a runmode called start, because CGI::App already registers one'; my $app = new MyTestApp(); my $t = $app->run; ok ($t =~ /called start mode called start/, $testname); } { my $testname = "override startrunmode per instance"; local $TODO = 'http://rt.cpan.org/Ticket/Display.html?id=23966'; my $app = new MyTestApp(); $app->start_mode('mode2'); my $t = $app->run; ok ($t =~ /called mode2 in the super class/, $testname) or diag $t; } } CGI-Application-Plugin-AutoRunmode-0.18/t/is_delegate_auto_runmode.t0000644000473500001440000000337111527434267024542 0ustar thilousers#!perl -T use Test::More tests => 7; BEGIN { use_ok('CGI::Application::Plugin::AutoRunmode') }; ######################### # Test CGI::App class { package MyTestApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun]; sub setup{ my $self = shift; $self->param( '::Plugin::AutoRunmode::delegate' => 'MyTestDelegate' ); } sub not_a_runmode{ 'not a runmode'; } } # Test delegate { package MyTestDelegate; sub mode1 { my ($self, $delegate) = @_; die "expected CGI::App instance as first parameter" unless $self->isa('CGI::Application'); die "expected delegate class or instance as second parameter" unless $delegate; 'called mode1'; } } $ENV{CGI_APP_RETURN_ONLY} = 1; $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = 'rm=mode1'; use CGI; my $q = new CGI; { my $testname = "call with no runmode"; my $app = new MyTestApp(QUERY=>$q); my $t = $app->run; ok( CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'mode1'), "[$testname] mode1"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'not_a_runmode'), "[$testname] not_a_runode"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'non_existing'), "[$testname] non_existing"); } { my $testname = "call with mode1"; $q->param(rm => 'mode1'); my $app = new MyTestApp(QUERY=>$q); my $t = $app->run; ok( CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'mode1'), "[$testname] mode1"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'not_a_runmode'), "[$testname] not_a_runode"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'non_existing'), "[$testname] non_existing"); } 1;CGI-Application-Plugin-AutoRunmode-0.18/t/delegate.t0000644000473500001440000000625411527434267021271 0ustar thilousers#!perl -T ######################### use Test::More tests => 10; BEGIN { use_ok('CGI::Application::Plugin::AutoRunmode') }; ######################### # Test CGI::App class { package MyTestApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun]; sub setup{ my $self = shift; $self->param( '::Plugin::AutoRunmode::delegate' => 'MyTestDelegate' ); } } # Test delegate { package MyTestDelegate; sub mode1 { my ($self, $delegate) = @_; die "expected CGI::App instance as first parameter" unless $self->isa('CGI::Application'); die "expected delegate class or instance as second parameter" unless $delegate; 'called mode1'; } } $ENV{CGI_APP_RETURN_ONLY} = 1; $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = 'rm=mode1'; use CGI; my $q = new CGI; { my $testname = "call delegate runmode (class)"; my $app = new MyTestApp(QUERY=>$q); my $t = $app->run; ok ($t =~ /called mode1/, $testname); } { my $testname = "call delegate runmode (object)"; my $app = new MyTestApp(QUERY=>$q); $app->param("::Plugin::AutoRunmode::delegate" => bless {}, 'MyTestDelegate'); my $t = $app->run; ok ($t =~ /called mode1/, $testname); } { my $testname = "try to call a not-runmode"; $q->param(rm => 'can'); my $app = new MyTestApp(QUERY=>$q); eval{ my $t = $app->run; }; ok ($@ =~ /No such run.mode/, $testname); } # delegate subclass { package MyTestSubDelegate; @MyTestSubDelegate::ISA = qw[MyTestDelegate ]; sub mode2 { 'called mode2'; } sub mode3{ my ($app, $delegate) = @_; 'called mode3 '.$delegate->{hey}; } } { my $testname = "runmode from a superclass"; $q->param(rm => 'mode1'); my $app = new MyTestApp(QUERY=>$q); $app->param("::Plugin::AutoRunmode::delegate" => 'MyTestSubDelegate'); my $t = $app->run; ok ($t =~ /called mode1/, $testname); } { my $testname = "runmode from a subclass"; $q->param(rm => 'mode2'); my $app = new MyTestApp(QUERY=>$q); $app->param("::Plugin::AutoRunmode::delegate" => 'MyTestSubDelegate'); my $t = $app->run; ok ($t =~ /called mode2/, $testname); } { my $testname = "security check - calling packaged runmode"; $q->param(rm => 'MyTestApp::setup'); my $app = new MyTestApp(QUERY=>$q); eval{ my $t = $app->run; }; ok ($@ =~ /^No such/, $testname); } { my $testname = "stateful delegate"; $q->param(rm => 'mode3'); my $app = new MyTestApp(QUERY=>$q); $app->param("::Plugin::AutoRunmode::delegate" => bless {hey => 'aaa'}, 'MyTestSubDelegate'); my $t = $app->run; ok ($t =~ /called mode3 aaa/, $testname); } # delegate chain { my $testname = "delegate chain: call first one"; $q->param(rm => 'mode1'); my $app = new MyTestApp(QUERY=>$q); $app->param("::Plugin::AutoRunmode::delegate" => [ 'MyTestDelegate', bless {hey => 'bbb'}, 'MyTestSubDelegate' ]); my $t = $app->run; ok ($t =~ /called mode1/, $testname); } { my $testname = "delegate chain: call second one"; $q->param(rm => 'mode3'); my $app = new MyTestApp(QUERY=>$q); $app->param("::Plugin::AutoRunmode::delegate" => [ 'MyTestDelegate', bless {hey => 'bbb'}, 'MyTestSubDelegate' ]); my $t = $app->run; ok ($t =~ /called mode3 bbb/, $testname); } CGI-Application-Plugin-AutoRunmode-0.18/t/apache2_reload.t0000644000473500001440000000076111527434267022345 0ustar thilousers#!perl -T use CGI; use lib 't/mocklibs'; use Apache2::Reload; use Test::More tests => 1; use strict; use warnings; { my $testname = "can redeclare start and error modes with Apache2::Reload"; { package MyTestApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun ]; # for CGI::App 3 compatibility sub mode1 : StartRunmode { } sub mode2 : StartRunmode { } sub mode3 : ErrorRunmode { } sub mode4 : ErrorRunmode { } } ok(1); } CGI-Application-Plugin-AutoRunmode-0.18/t/error_runmode.t0000644000473500001440000000446111527434267022377 0ustar thilousers#!perl -T use Test::More tests => 7; use strict; use warnings; use CGI; BEGIN { use_ok('CGI::Application::Plugin::AutoRunmode') }; SKIP: { skip 'requires CGI::App v3.30 and above', 6 unless $CGI::Application::VERSION >= '3.30'; $ENV{CGI_APP_RETURN_ONLY} = 1; { package MyTestApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun ]; # for CGI::App 3 compatibility sub mode1 : ErrorRunmode { 'called mode1'; } sub mode2 { 'called mode2 in the super class' } sub mode3 : StartRunmode{ die 'hey'; } } { package MyTestSubApp; use base 'MyTestApp'; sub mode2 : ErrorRunMode { 'called mode2 in the sub class'; } } { my $testname = "autodetect error runmode "; my $app = new MyTestApp(); my $t = $app->run; ok ($t =~ /called mode1/, $testname) or diag $t; } { my $testname = "error runmode is not a regular runmode"; my $q = new CGI({'rm' =>'mode1'}); my $app = new MyTestApp(QUERY=>$q); eval{ $app->run; }; ok ($@ =~ /No such run mode 'mode1'/, $testname); } { package MyTestSubApp2; use base 'MyTestApp'; sub mode2 : ErrorRunmode :Runmode { 'called mode2 in the sub class'; } } { my $testname = "error runmode is also a regular runmode"; my $q = new CGI({'rm' =>'mode2'}); my $app = new MyTestSubApp2(QUERY=>$q); my $t = $app->run; ok ($t =~ /called mode2 in the sub class/, $testname); } { my $testname = "autodetect error runmode in subclass and case-insensitive "; my $app = new MyTestSubApp(); my $t = $app->run; ok ($t =~ /called mode2 in the sub class/, $testname); } { my $testname = "cannot install two ErrorRunmodes "; eval <<'CODE'; package MyTestAppBroken; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode; sub mode1 : ErrorRunmode { 'called mode1'; } sub mode2 : ErrorRunmode { 'called mode2'; } CODE ok ($@ =~ /ErrorRunmode for package MyTestAppBroken is already installed/, $testname); } TODO: { { my $testname = "override error runmode per instance"; local $TODO = 'http://rt.cpan.org/Ticket/Display.html?id=23966'; my $app = new MyTestApp(); $app->error_mode('mode2'); my $t = $app->run; ok ($t =~ /called mode2 in the super class/, $testname) or diag $t; } } }CGI-Application-Plugin-AutoRunmode-0.18/t/attribute_handlers.t0000644000473500001440000000553411527434267023402 0ustar thilousers#!perl -T # test to check interoperability with other plugins that use # Attribute::Handlers # use Test::More tests => 16; use strict; use warnings; use Data::Dumper; use lib 'blib/../t'; my $has_ah; my $has_myplugin; my $has_myapp; BEGIN { eval <<'EVAL'; use Attribute::Handlers; $has_ah = 1; package MyPlugin; our %RUNMODES; use Attribute::Handlers; sub CGI::Application::Authen : ATTR(CODE) { my ( $package, $symbol, $referent, $attr, $data, $phase ) = @_; no strict 'refs'; $RUNMODES{$referent} = 1; } $has_myplugin = 1; package MyApp; use base qw(CGI::Application); use CGI::Application::Plugin::AutoRunmode qw(cgiapp_prerun); sub test :Authen { return 'test' } sub test2 :Authen :Runmode { return 'test2' } sub test3 :Runmode { return 'test3' } package MySubApp; use base qw[ MyApp] ; sub test :Runmode { return 'made into a run mode'; } sub test2 { return 'no longer a run mode' } sub test3 :Runmode { 'still a run mode' } $has_myapp = 1; EVAL diag $@ if $@; } SKIP: { skip 'needs Attribute::Handlers', 16 unless $has_ah; is($has_myplugin, 1, 'compile plugin that defines attributes'); is($has_myapp, 1, 'compile MyApp that uses attributes'); $ENV{CGI_APP_RETURN_ONLY} = 1; $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = 'rm=test2'; use CGI; my $q = new CGI; { my $app = new MyApp(QUERY=>$q); my $t = $app->run; like ($t , qr/test2/, 'call runmode with extra attribute'); ok($MyPlugin::RUNMODES{$app->can('test2')}, 'extra attribute has been installed'); } { $q->param(rm => 'test3'); my $app = new MyApp(QUERY=>$q); my $t = $app->run; like ($t , qr/test3/, 'call runmode without extra attribute'); ok ( not ($MyPlugin::RUNMODES{$app->can('test3')}), 'no extra attribute has been installed when not requested'); } { my $testname = "try to call a not-runmode"; $q->param(rm => 'test'); my $app = new MyApp(QUERY=>$q); eval{ my $t = $app->run; }; ok ($@ =~ /test/, $testname); ok($MyPlugin::RUNMODES{$app->can('test')}, 'extra attribute has been installed on non-runmode'); } skip 'needs CGI::Application version 4', 8 unless $CGI::Application::VERSION >= 4; { my $testname = "run-modes have been inserted into modemap"; $q->param(rm => ''); my $app = new MyApp(QUERY=>$q); $app->run; my %rmodes = $app->run_modes(); is (scalar(keys %rmodes), 3, 'number of runmodes') || diag Dumper \%rmodes; ok ($rmodes{$_}, "runmode $_ registered") foreach qw[ test2 test3 start] ; } { my $testname = "subclass can override run-modes inserted into modemap"; $q->param(rm => ''); my $app = new MySubApp(QUERY=>$q); $app->run; my %rmodes = $app->run_modes(); is (scalar(keys %rmodes), 3, 'number of runmodes') || diag Dumper \%rmodes; ok ($rmodes{$_}, "runmode $_ registered") foreach qw[ test test3 start] ; } } CGI-Application-Plugin-AutoRunmode-0.18/t/is_auto_runmode.t0000644000473500001440000000465311527434267022714 0ustar thilousers#!perl -T # This test suite has been contributed by Michael Graham # who also suggested the is_auto_runmode function ######################### use Test::More tests => 13; BEGIN { use_ok('CGI::Application::Plugin::AutoRunmode') }; ######################### # Test CGI::App class { package MyTestApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun ]; sub mode1 : Runmode { 'mode1'; } sub not_a_runmode{ 'not a runmode'; } sub start_mode1 : StartRunmode { 'start_mode1'; } } $ENV{CGI_APP_RETURN_ONLY} = 1; $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = 'rm=mode1'; use CGI; my $q = new CGI; { my $testname = "call with no runmode"; my $app = new MyTestApp(QUERY=>$q); my $t = $app->run; ok( CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'mode1'), "[$testname] mode1"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'not_a_runmode'), "[$testname] not_a_runode"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'non_existing'), "[$testname] non_existing"); ok( CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'start_mode1'), "[$testname] start_mode1"); } { my $testname = "call with mode1"; $q->param(rm => 'mode1'); my $app = new MyTestApp(QUERY=>$q); my $t = $app->run; ok( CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'mode1'), "[$testname] mode1"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'not_a_runmode'), "[$testname] not_a_runode"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'non_existing'), "[$testname] non_existing"); ok( CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'start_mode1'), "[$testname] start_mode1"); } { my $testname = "start_mode1"; $q->param(rm => 'start_mode1'); my $app = new MyTestApp(QUERY=>$q); my $t = $app->run; ok( CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'mode1'), "[$testname] mode1"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'not_a_runmode'), "[$testname] not_a_runode"); ok(!CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'non_existing'), "[$testname] non_existing"); ok( CGI::Application::Plugin::AutoRunmode::is_auto_runmode($app, 'start_mode1'), "[$testname] start_mode1"); } 1;CGI-Application-Plugin-AutoRunmode-0.18/t/file_delegate.t0000644000473500001440000000324611527434267022266 0ustar thilousers#!perl -T ######################### use Test::More tests => 5; BEGIN { use_ok('CGI::Application::Plugin::AutoRunmode::FileDelegate') }; ######################### # Test CGI::App class { package MyTestApp; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun]; sub setup{ my $self = shift; $self->param( '::Plugin::AutoRunmode::delegate' => new CGI::Application::Plugin::AutoRunmode::FileDelegate('t/runmodes') ); } } { package MyTestAppWithTwoDirectories; use base 'CGI::Application'; use CGI::Application::Plugin::AutoRunmode qw [ cgiapp_prerun]; sub setup{ my $self = shift; $self->param( '::Plugin::AutoRunmode::delegate' => new CGI::Application::Plugin::AutoRunmode::FileDelegate('t/runmodes', 't/runmodes/sub') ); } } $ENV{CGI_APP_RETURN_ONLY} = 1; $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = 'rm=mode1&tainted=' . $ENV{PATH}; use CGI; my $q = new CGI; { my $testname = "call delegate runmode"; my $app = new MyTestApp(QUERY=>$q); my $t = $app->run; ok ($t =~ /called mode1/, $testname); } { my $testname = "security check - try to escape"; $q->param(rm => '../runmodes/mode1'); my $app = new MyTestApp(QUERY=>$q); eval{ my $t = $app->run; }; ok ($@ =~ /^No such/, $testname); } { my $testname = "security check also disallows subdirectories"; $q->param(rm => 'sub/submode'); my $app = new MyTestApp(QUERY=>$q); eval{ my $t = $app->run; }; ok ($@ =~ /^No such/, $testname); } { my $testname = "multiple directories"; $q->param(rm => 'submode'); my $app = new MyTestAppWithTwoDirectories(QUERY=>$q); my $t = $app->run; ok ($t =~ /called submode/, $testname); }