CGI-Application-Plugin-Forward-1.06/0042755000175200001440000000000010325063604016471 5ustar michaelusersCGI-Application-Plugin-Forward-1.06/t/0042755000175200001440000000000010325063604016734 5ustar michaelusersCGI-Application-Plugin-Forward-1.06/t/02-examples.t0100644000175200001440000000504310325063604021153 0ustar michaelusers#!/usr/bin/perl use strict; use Test::More 'no_plan'; $ENV{CGI_APP_RETURN_ONLY} = 1; { package Example1; use vars qw(@ISA); use Test::More; use CGI::Application; use CGI::Application::Plugin::Forward; @ISA = ('CGI::Application'); use CGI::Application::Plugin::Forward; sub setup { my $self = shift; $self->run_modes([qw( start second_runmode )]); } sub start { my $self = shift; return $self->forward('second_runmode'); } sub second_runmode { my $self = shift; my $rm = $self->get_current_runmode; # 'second_runmode' is($rm,'second_runmode','rm=second_runmode'); } } Example1->new->run; { package Example2; use vars qw(@ISA); use Test::More; use CGI::Application; use CGI::Application::Plugin::Forward; @ISA = ('CGI::Application'); sub setup { my $self = shift; $self->run_modes({ start => 'start', other_action => 'other_method', }); } sub start { my $self = shift; return $self->forward('other_action'); } sub other_method { my $self = shift; my $rm = $self->get_current_runmode; # 'other_action' is($rm,'other_action','rm=other_action'); } } Example2->new->run; { package Example3; use vars qw(@ISA); use Test::More; use CGI::Application; use CGI::Application::Plugin::Forward; @ISA = ('CGI::Application'); sub setup { my $self = shift; $self->run_modes({ start => 'start', other_action => 'other_method', }); } sub start { my $self = shift; return $self->other_method; } sub other_method { my $self = shift; my $rm = $self->get_current_runmode; # 'start' is($rm,'start','rm=start'); } } Example3->new->run; { package Example4; use vars qw(@ISA); use Test::More; use CGI::Application; use CGI::Application::Plugin::Forward; @ISA = ('CGI::Application'); sub setup { my $self = shift; $self->run_modes({ start => 'start', anon_action => sub { my $self = shift; my $rm = $self->get_current_runmode; # 'anon_action' is($rm,'anon_action','rm=anon_action'); }, }); } sub start { my $self = shift; return $self->forward('anon_action'); } } Example4->new->run; CGI-Application-Plugin-Forward-1.06/t/03-coderefs.t0100644000175200001440000000176710325063604021141 0ustar michaelusers#!/usr/bin/perl use strict; # the number of tests is important, because we want to make sure that # all run modes are actually reached use Test::More 'tests' => 3; { package WebApp; use vars qw(@ISA); use Test::More; use CGI::Application; use CGI::Application::Plugin::Forward; @ISA = ('CGI::Application'); sub setup { my $self = shift; $self->header_type('none'); $self->start_mode('action_one'); $self->run_modes({ action_one => 'meth_one', action_two => sub { my $self = shift; is($self->get_current_runmode, 'action_two', '[codref] crm: action_two'); return "coderefs work"; }, }); } sub meth_one { my $self = shift; is($self->get_current_runmode, 'action_one', '[meth_one] crm: action_one'); my $output = $self->forward('action_two'); is($output, 'coderefs work', 'coderefs work'); } } WebApp->new->run; CGI-Application-Plugin-Forward-1.06/t/pod.t0100644000175200001440000000021410325063604017673 0ustar michaelusers#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); CGI-Application-Plugin-Forward-1.06/t/01-forward.t0100644000175200001440000000344710325063604021006 0ustar michaelusers#!/usr/bin/perl use strict; # the number of tests is important, because we want to make sure that # all run modes are actually reached use Test::More 'tests' => 8; { package WebApp; use vars qw(@ISA); use Test::More; use CGI::Application; use CGI::Application::Plugin::Forward; @ISA = ('CGI::Application'); sub setup { my $self = shift; $self->header_type('none'); $self->start_mode('action_one'); $self->run_modes({ action_one => 'meth_one', action_two => 'meth_two', action_not => 'zzzzzzzz', }); } sub meth_one { my $self = shift; is($self->get_current_runmode, 'action_one', '[meth_one] crm: action_one'); $self->other_method('foo'); ''; } sub other_method { my $self = shift; my @params = @_; ok(eq_array(\@params, ['foo']), '[other_method] params'); is($self->get_current_runmode, 'action_one', '[other_method] crm: action_one'); my $output = $self->forward('action_two', 'bar', 'baz'); is($output, 'other_runmode_output', 'other_runmode output'); eval { $output = $self->forward('non_existent', 'bar', 'baz'); }; ok($@, 'prevented from forwarding to non-existent run mode'); eval { $output = $self->forward('action_not', 'bar', 'baz'); }; ok($@, 'prevented from forwarding to non-existent run mode method'); ''; } sub meth_two { my $self = shift; my @params = @_; ok(eq_array(\@params, ['bar', 'baz']), '[meth_two] params'); is($self->get_current_runmode, 'action_two', '[meth_two] crm: action_two'); return 'other_runmode_output'; } } WebApp->new->run; CGI-Application-Plugin-Forward-1.06/t/05-auto_runmode.t0100644000175200001440000000676710325063604022057 0ustar michaelusers#!/usr/bin/perl use strict; # the number of tests is important, because we want to make sure that # all run modes are actually reached use Test::More; BEGIN { eval { require CGI::Application::Plugin::AutoRunmode; }; if ($@) { plan skip_all => 'CGI::Application::Plugin::AutoRunmode not installed'; } if (!CGI::Application->can('new_hook')) { plan skip_all => 'installed CGI::Application does not support callbacks'; } else { if (CGI::Application::Plugin::AutoRunmode->can('is_auto_runmode')) { plan 'tests' => 17; CGI::Application::Plugin::AutoRunmode->import('cgiapp_prerun'); } else { plan skip_all => 'installed CGI::Application::Plugin::AutoRunmode does not support is_auto_runmode'; } } } { package WebApp; use vars qw(@ISA); use Test::More; use CGI::Application; BEGIN { @ISA = ('CGI::Application'); } use CGI::Application::Plugin::Forward; BEGIN { CGI::Application::Plugin::AutoRunmode->import('cgiapp_prerun'); } sub setup { my $self = shift; $self->header_type('none'); $self->param('hook' => 0); $self->add_callback('forward_prerun', \&hooked_method); } sub meth_one : StartRunmode { my $self = shift; is($self->get_current_runmode, 'meth_one', '[meth_one] crm: meth_one'); ok(!$self->param('hook'), '[meth_one] hook not called yet 1'); $self->other_method('foo'); ok(!$self->param('hook'), '[meth_one] hook not called yet 2'); ''; } sub other_method : Runmode { my $self = shift; my @params = @_; ok(!$self->param('hook'), '[other_method] hook not called yet 1'); ok(eq_array(\@params, ['foo']), '[other_method] params'); is($self->get_current_runmode, 'meth_one', '[other_method] crm: meth_one'); my $output = $self->forward('meth_two', 'bar', 'baz'); is($self->param('hook'), 'meth_two', '[other_method] hook called'); $self->param('hook' => 0); ok(!$self->param('hook'), '[other_method] hook not called yet 2'); is($output, 'other_runmode_output', 'other_runmode output'); eval { $output = $self->forward('non_existent', 'bar', 'baz'); }; ok($@, 'prevented from forwarding to non-existent run mode'); ok(!$self->param('hook'), '[other_method] hook not called yet 3 (after non-existent)'); eval { $output = $self->forward('action_not', 'bar', 'baz'); }; ok(!$self->param('hook'), '[other_method] hook not called yet 4 (after non-existent)'); ok($@, 'prevented from forwarding to non-existent run mode method'); is($self->get_current_runmode, 'meth_two', '[other_method] crm: meth_one'); ''; } sub meth_two : Runmode { my $self = shift; my @params = @_; ok($self->param('hook'), '[meth_two] hook called'); ok(eq_array(\@params, ['bar', 'baz']), '[meth_two] params'); is($self->get_current_runmode, 'meth_two', '[meth_two] crm: meth_two'); return 'other_runmode_output'; } sub action_not { my $self = shift; } sub hooked_method { my $self = shift; $self->param('hook' => $self->get_current_runmode); } } WebApp->new->run; CGI-Application-Plugin-Forward-1.06/t/00.load.t0100644000175200001440000000026710325063604020256 0ustar michaelusersuse Test::More tests => 1; BEGIN { use_ok( 'CGI::Application::Plugin::Forward' ); } diag( "Testing CGI::Application::Plugin::Forward $CGI::Application::Plugin::Forward::VERSION" ); CGI-Application-Plugin-Forward-1.06/t/pod-coverage.t0100644000175200001440000000025410325063604021470 0ustar michaelusers#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); CGI-Application-Plugin-Forward-1.06/t/04-forward_prerun_hook.t0100644000175200001440000000566410325063604023427 0ustar michaelusers#!/usr/bin/perl use strict; # the number of tests is important, because we want to make sure that # all run modes are actually reached use Test::More; if (CGI::Application->can('new_hook')) { plan 'no_plan'; } else { plan skip_all => 'installed version of CGI::Application does not support callbacks'; } { package WebApp; use vars qw(@ISA); use Test::More; use CGI::Application; use CGI::Application::Plugin::Forward; @ISA = ('CGI::Application'); sub setup { my $self = shift; $self->header_type('none'); $self->start_mode('action_one'); $self->param('hook' => 0); $self->add_callback('forward_prerun', \&hooked_method); $self->run_modes({ action_one => 'meth_one', action_two => 'meth_two', action_not => 'zzzzzzzz', }); } sub meth_one { my $self = shift; is($self->get_current_runmode, 'action_one', '[meth_one] crm: action_one'); ok(!$self->param('hook'), '[meth_one] hook not called yet 1'); $self->other_method('foo'); ok(!$self->param('hook'), '[meth_one] hook not called yet 2'); ''; } sub other_method { my $self = shift; my @params = @_; ok(!$self->param('hook'), '[other_method] hook not called yet 1'); ok(eq_array(\@params, ['foo']), '[other_method] params'); is($self->get_current_runmode, 'action_one', '[other_method] crm: action_one'); my $output = $self->forward('action_two', 'bar', 'baz'); is($self->param('hook'), 'action_two', '[other_method] hook called'); $self->param('hook' => 0); ok(!$self->param('hook'), '[other_method] hook not called yet 2'); is($output, 'other_runmode_output', 'other_runmode output'); eval { $output = $self->forward('non_existent', 'bar', 'baz'); }; ok($@, 'prevented from forwarding to non-existent run mode'); ok(!$self->param('hook'), '[other_method] hook not called yet 3 (after non-existent)'); eval { $output = $self->forward('action_not', 'bar', 'baz'); }; ok(!$self->param('hook'), '[other_method] hook not called yet 4 (after non-existent)'); ok($@, 'prevented from forwarding to non-existent run mode method'); ''; } sub meth_two { my $self = shift; my @params = @_; ok($self->param('hook'), '[meth_two] hook called'); ok(eq_array(\@params, ['bar', 'baz']), '[meth_two] params'); is($self->get_current_runmode, 'action_two', '[meth_two] crm: action_two'); return 'other_runmode_output'; } sub hooked_method { my $self = shift; $self->param('hook' => $self->get_current_runmode); } } WebApp->new->run; CGI-Application-Plugin-Forward-1.06/lib/0042755000175200001440000000000010325063604017237 5ustar michaelusersCGI-Application-Plugin-Forward-1.06/lib/CGI/0042755000175200001440000000000010325063604017641 5ustar michaelusersCGI-Application-Plugin-Forward-1.06/lib/CGI/Application/0042755000175200001440000000000010325063604022104 5ustar michaelusersCGI-Application-Plugin-Forward-1.06/lib/CGI/Application/Plugin/0042755000175200001440000000000010325063604023342 5ustar michaelusersCGI-Application-Plugin-Forward-1.06/lib/CGI/Application/Plugin/Forward.pm0100644000175200001440000001715110325063604025304 0ustar michaeluserspackage CGI::Application::Plugin::Forward; use warnings; use strict; use Carp; use vars qw(@ISA @EXPORT); @ISA = ('Exporter'); @EXPORT = ('forward'); =head1 NAME CGI::Application::Plugin::Forward - Pass control from one run mode to another =head1 VERSION Version 1.06 =cut our $VERSION = '1.06'; use CGI::Application; if (CGI::Application->can('new_hook')) { CGI::Application->new_hook('forward_prerun'); } =head1 SYNOPSIS use base 'CGI::Application'; use CGI::Application::Plugin::Forward; sub setup { my $self = shift; $self->run_modes([qw( start second_runmode )]); } sub start { my $self = shift; return $self->forward('second_runmode'); } sub second_runmode { my $self = shift; my $rm = $self->get_current_runmode; # 'second_runmode' } =head1 DESCRIPTION The forward method passes control to another run mode and returns its output. This is equivalent to calling C<< $self->$other_runmode >>, except that L's internal value of the current run mode is updated. This means that calling C<< $self->get_current_runmode >> after calling C will return the name of the new run mode. This is useful for modules that depend on the name of the current run mode such as L. For example, here's how to pass control to a run mode named C from C while updating the value of C: sub setup { my $self = shift; $self->run_modes({ start => 'start', other_action => 'other_method', }); } sub start { my $self = shift; return $self->forward('other_action'); } sub other_method { my $self = shift; my $rm = $self->get_current_runmode; # 'other_action' } Note that forward accepts the I of the run mode (in this case I<'other_action'>), which might not be the same as the name of the method that handles the run mode (in this case I<'other_method'>) You can still call C<< $self->other_method >> directly, but C will not be updated: sub setup { my $self = shift; $self->run_modes({ start => 'start', other_action => 'other_method', }); } sub start { my $self = shift; return $self->other_method; } sub other_method { my $self = shift; my $rm = $self->get_current_runmode; # 'start' } Forward will work with coderef-based runmodes as well: sub setup { my $self = shift; $self->run_modes({ start => 'start', anon_action => sub { my $self = shift; my $rm = $self->get_current_runmode; # 'anon_action' }, }); } sub start { my $self = shift; return $self->forward('anon_action'); } =head1 FORWARD vs. REDIRECT Calling C changes the run mode of your application, but it stays within the same HTTP request. To redirect to a new runmode using a completely new web request, you might consider using the C method provided by L. The advantage of using an external redirect as opposed to an internal forward is that it provides a 'clean break' between pages. For instance, in a typical BREAD application (Browse, Read, Edit, Add, Delete), after the user completes an action, you usually return the user to the Browse list. For instance, when the user adds a new record via a POST form, and your app returns them to the list of records. If you use C, then you are still in the same request as the original I. The user might hit I, expecting to refresh the list of records. But in fact, I will attempt to repost the I form. The user's browser might present a warning about reposting the same data. The browser may refuse to redisplay the page, due for caching reasons. So in this case, it may make more sense to do a fresh HTTP redirect back to the Browse list. =head1 METHODS =head2 forward Runs another run mode passing any parameters you supply. Returns the output of the new run mode. return $self->forward('run_mode_name', @run_mode_params); =cut sub forward { my $self = shift; my $run_mode = shift; if ($CGI::Application::Plugin::AutoRunmode::VERSION) { if (CGI::Application::Plugin::AutoRunmode->can('is_auto_runmode')) { if (CGI::Application::Plugin::AutoRunmode::is_auto_runmode($self, $run_mode)) { $self->run_modes( $run_mode => $run_mode); } } } my %rm_map = $self->run_modes; if (not exists $rm_map{$run_mode}) { croak "CAP::Forward: run mode $run_mode does not exist"; } my $method = $rm_map{$run_mode}; if ($self->can($method) or ref $method eq 'CODE') { $self->{__CURRENT_RUNMODE} = $run_mode; if ($self->can('call_hook')) { $self->call_hook('forward_prerun'); } return $self->$method(@_); } else { croak "CAP::Forward: target method $method of run mode $run_mode does not exist"; } } =head1 HOOKS Before the forwarded run mode is called, the C hook is called. You can use this hook to do any prep work that you want to do before any new run mode gains control. This is similar to L's built in C method, but it is called each time you call L; not just the when your application starts. sub setup { my $self = shift; $self->add_callback('forward_prerun' => \&prepare_rm_stuff); } sub prepare_rm_stuff { my $self = shift; # do any necessary prep work here.... } Note that your hooked method will only be called when you call L. If you never call C, the hook will not be called. In particuar, the hook will not be called for your application's C. For that, you still use C. If you want to have a method run for every run mode I the C, then you can call the hook directly from C. sub setup { my $self = shift; $self->add_callback('forward_prerun' => \&prepare_rm_stuff); } sub cgiapp_prerun { my $self = shift; $self->prepare_rm_stuff; } sub prepare_rm_stuff { my $self = shift; # do any necessary prep work here.... } Alternately, you can hook C to the C hook: sub setup { my $self = shift; $self->add_callback('forward_prerun' => \&cgiapp_prerun); } sub cgiapp_prerun { my $self = shift; # do any necessary prep work here.... } This is a less flexible solution, since certain things that can be done in C (like setting C) won't work when the method is called from the C hook. =head1 AUTHOR Michael Graham, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS Thanks to Mark Stosberg for the idea and...well...the implementation as well. =head1 COPYRIGHT & LICENSE Copyright 2005 Michael Graham, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of CGI::Application::Plugin::ForwardCGI-Application-Plugin-Forward-1.06/misc/0042755000175200001440000000000010325063604017424 5ustar michaelusersCGI-Application-Plugin-Forward-1.06/misc/dist0100644000175200001440000000017710325063604020312 0ustar michaelusers#!/bin/sh rm MANIFEST misc/makedocs.pl perl ./Build.PL perl ./Build perl ./Build manifest perl ./Build test perl ./Build dist CGI-Application-Plugin-Forward-1.06/misc/module-starter-opts.txt0100644000175200001440000000020410325063604024106 0ustar michaelusers $ module-starter --mb --module=CGI::Application::Plugin::Forward --author="Michael Graham" --email=mag-perl@occamstoothbrush.com CGI-Application-Plugin-Forward-1.06/misc/style.css0100644000175200001440000001136710325063604021301 0ustar michaelusersBODY, .logo { background: white; } BODY { color: black; font-family: arial,sans-serif; margin: 0; padding: 1ex; } TABLE { border-collapse: collapse; border-spacing: 0; border-width: 0; color: inherit; } IMG { border: 0; } FORM { margin: 0; } input { margin: 2px; } .logo { float: left; width: 264px; height: 77px; } .front .logo { float: none; display:block; } .front .searchbox { margin: 2ex auto; text-align: center; } .front .menubar { text-align: center; } .menubar { background: #006699; margin: 1ex 0; padding: 1px; } .menubar A { padding: 0.8ex; font: bold 10pt Arial,Helvetica,sans-serif; } .menubar A:link, .menubar A:visited { color: white; text-decoration: none; } .menubar A:hover { color: #ff6600; text-decoration: underline; } A:link, A:visited { background: transparent; color: #006699; } A[href="#POD_ERRORS"] { background: transparent; color: #FF0000; } TD { margin: 0; padding: 0; } DIV { border-width: 0; } DT { margin-top: 1em; } .credits TD { padding: 0.5ex 2ex; } .huge { font-size: 32pt; } .s { background: #dddddd; color: inherit; } .s TD, .r TD { padding: 0.2ex 1ex; vertical-align: baseline; } TH { background: #bbbbbb; color: inherit; padding: 0.4ex 1ex; text-align: left; } TH A:link, TH A:visited { background: transparent; color: black; } .box { border: 1px solid #006699; margin: 1ex 0; padding: 0; } .distfiles TD { padding: 0 2ex 0 0; vertical-align: baseline; } .manifest TD { padding: 0 1ex; vertical-align: top; } .l1 { font-weight: bold; } .l2 { font-weight: normal; } .t1, .t2, .t3, .t4 { background: #006699; color: white; } .t4 { padding: 0.2ex 0.4ex; } .t1, .t2, .t3 { padding: 0.5ex 1ex; } /* IE does not support .box>.t1 Grrr */ .box .t1, .box .t2, .box .t3 { margin: 0; } .t1 { font-size: 1.4em; font-weight: bold; text-align: center; } .t2 { font-size: 1.0em; font-weight: bold; text-align: left; } .t3 { font-size: 1.0em; font-weight: normal; text-align: left; } /* width: 100%; border: 0.1px solid #FFFFFF; */ /* NN4 hack */ .datecell { text-align: center; width: 17em; } .cell { padding: 0.2ex 1ex; text-align: left; } .label { background: #aaaaaa; color: black; font-weight: bold; padding: 0.2ex 1ex; text-align: right; white-space: nowrap; vertical-align: baseline; } .categories { border-bottom: 3px double #006699; margin-bottom: 1ex; padding-bottom: 1ex; } .categories TABLE { margin: auto; } .categories TD { padding: 0.5ex 1ex; vertical-align: baseline; } .path A { background: transparent; color: #006699; font-weight: bold; } .pages { background: #dddddd; color: #006699; padding: 0.2ex 0.4ex; } .path { background: #dddddd; border-bottom: 1px solid #006699; color: #006699; /* font-size: 1.4em;*/ margin: 1ex 0; padding: 0.5ex 1ex; } .menubar TD { background: #006699; color: white; } .menubar { background: #006699; color: white; margin: 1ex 0; padding: 1px; } .menubar .links { background: transparent; color: white; padding: 0.2ex; text-align: left; } .menubar .searchbar { background: black; color: black; margin: 0px; padding: 2px; text-align: right; } A.m:link, A.m:visited { background: #006699; color: white; font: bold 10pt Arial,Helvetica,sans-serif; text-decoration: none; } A.o:link, A.o:visited { background: #006699; color: #ccffcc; font: bold 10pt Arial,Helvetica,sans-serif; text-decoration: none; } A.o:hover { background: transparent; color: #ff6600; text-decoration: underline; } A.m:hover { background: transparent; color: #ff6600; text-decoration: underline; } table.dlsip { background: #dddddd; border: 0.4ex solid #dddddd; } .pod PRE { background: #eeeeee; border: 1px solid #888888; color: black; padding: 1em; white-space: pre; } .pod H1 { background: transparent; color: #006699; font-size: large; } .pod H2 { background: transparent; color: #006699; font-size: medium; } .pod IMG { vertical-align: top; } .pod .toc A { text-decoration: none; } .pod .toc LI { line-height: 1.2em; list-style-type: none; } .faq DT { font-size: 1.4em; font-weight: bold; } .chmenu { background: black; color: red; font: bold 1.1em Arial,Helvetica,sans-serif; margin: 1ex auto; padding: 0.5ex; } .chmenu TD { padding: 0.2ex 1ex; } .chmenu A:link, .chmenu A:visited { background: transparent; color: white; text-decoration: none; } .chmenu A:hover { background: transparent; color: #ff6600; text-decoration: underline; } .column { padding: 0.5ex 1ex; vertical-align: top; } .datebar { margin: auto; width: 14em; } .date { background: transparent; color: #008000; } CGI-Application-Plugin-Forward-1.06/misc/makedocs.pl0100644000175200001440000000330410325063604021542 0ustar michaelusers#!/usr/bin/perl # This is a Quick and dirty script to generate docs. # # It can do three things: # 1) make HTML docs that look like those on search.cpan.org # 2) make text docs # 3) copy files # # Run this from the main module directory with: # $ misc/makedocs.pl # my $StyleSheet = "misc/style.css"; my %HTML = ( 'CAP-Forward.html' => 'lib/CGI/Application/Plugin/Forward.pm', ); my %TEXT = ( 'README' => 'lib/CGI/Application/Plugin/Forward.pm', ); my %COPY = ( 'changes.txt' => 'Changes', 'readme.txt' => 'README', ); my @Tempfiles = qw( pod2htmd.tmp pod2htmd.x~~ pod2htmi.tmp pod2htmi.x~~ ); use strict; use File::Copy; local $/; foreach my $target (keys %TEXT) { my $source = $TEXT{$target}; system("pod2text $source $target"); } foreach my $target (keys %HTML) { my $source = $HTML{$target}; system("pod2html --css=$StyleSheet $source $target"); open my $fh, $target or die "can't read $target: $!\n"; my $text = <$fh>; close $fh; # Add
...
$text =~ s/(]*>)/$1
/i; $text =~ s/(<\/body>)/<\/div>$1/i; # remove redundant 
 sequences (only necessary in old pod2html)
    # $text =~ s/<\/pre>(\s*)
/$1/imsg;

    # remove redundant 
  
 
 tags (only necessary in old pod2html)
    # $text =~ s/<\/pre>(\s*)<\/dd>\s*
\s*
/$1/imsg;


    open my $fh, '>', $target or die "can't clobber $target: $!\n";
    print $fh $text;
    close $fh;

    foreach my $tempfile (@Tempfiles) {
        unlink $tempfile;
    }
}

foreach my $target (keys %COPY) {
    my $source = $COPY{$target};
    copy($source, $target);
}

CGI-Application-Plugin-Forward-1.06/misc/prove_prereqs.pl0100644000175200001440000000461510325063604022656 0ustar  michaelusers#!/usr/bin/perl

=pod

This script allows you to run the test suite against old versions of
prerequisite modules, or absent prerequisites.

It is able to simulate the absense of a particular set of Perl modules,
even if they are installed on your system.

To run the test suite multiple times in a row, each tie multiple times
(each with a different selection of absent modules), run:

    $ perl misc/prove_prereqs.pl t/*.t

To add a new set of absent modules, make a subdir under t/skip_lib, and
add a dummy perl module for every module you want to skip.  This file
should be empty.  For instance if you wanted to simulate the absense of
Text::Template and Text::TagTemplate, you would do the following:

    $ mkdir t/prereq_scenarios/old_autorunmode
    $ mkdir t/prereq_scenarios/old_cgiapp

Finally, add this directory to the @Scenarios array below.

=cut

my @Scenarios = qw(
    t/prereq_scenarios/old_autorunmode-0.08
    t/prereq_scenarios/old_autorunmode-0.09
    t/prereq_scenarios/old_autorunmode-0.10
    t/prereq_scenarios/old_cgiapp
    t/prereq_scenarios/normal
);

###################################################################
use strict;
use File::Find;

unless (@ARGV) {
    die "Usage: $0 [args to prove]\n";
}

my %Skip_Modules;
my $errors;
foreach my $skip_lib_dir (@Scenarios) {
    if (!-d $skip_lib_dir) {
        $errors = 1;
        warn "Skip lib dir does not exist: $skip_lib_dir\n";
        next;
    }
    my @modules;
    find(sub {
        return unless -f;
        my $dir = "$File::Find::dir/$_";
        $dir =~ s/^\Q$skip_lib_dir\E//;
        $dir =~ s/\.pm$//;
        $dir =~ s{^/}{};
        $dir =~ s{/}{::}g;
        push @modules, $dir;
    }, $skip_lib_dir);
    $Skip_Modules{$skip_lib_dir} = \@modules;
}
die "Terminating." if $errors;

foreach my $skip_lib_dir (@Scenarios) {
    my $modules = join ', ', sort @{ $Skip_Modules{$skip_lib_dir} };
    $modules ||= 'none';
    print "\n##############################################################\n";
    print "Running tests.  Special Modules: $modules\n";
    my @prove_command = ('prove', '-Ilib', "-I$skip_lib_dir", @ARGV);
    system(@prove_command) && do {
        die <run_modes([qw(
                start
                second_runmode
            )]);
        }
        sub start {
            my $self = shift;
            return $self->forward('second_runmode');
        }
        sub second_runmode {
            my $self = shift;

            my $rm = $self->get_current_runmode;  # 'second_runmode'

        }

DESCRIPTION
    The forward method passes control to another run mode and returns its
    output. This is equivalent to calling "$self->$other_runmode", except
    that CGI::Application's internal value of the current run mode is
    updated.

    This means that calling "$self->get_current_runmode" after calling
    "forward" will return the name of the new run mode. This is useful for
    modules that depend on the name of the current run mode such as
    CGI::Application::Plugin::AnyTemplate.

    For example, here's how to pass control to a run mode named
    "other_action" from "start" while updating the value of
    "current_run_mode":

        sub setup {
            my $self = shift;
            $self->run_modes({
                start         => 'start',
                other_action  => 'other_method',
            });
        }
        sub start {
            my $self = shift;
            return $self->forward('other_action');
        }
        sub other_method {
            my $self = shift;

            my $rm = $self->get_current_runmode;  # 'other_action'
        }

    Note that forward accepts the *name* of the run mode (in this case
    *'other_action'*), which might not be the same as the name of the method
    that handles the run mode (in this case *'other_method'*)

    You can still call "$self->other_method" directly, but
    "current_run_mode" will not be updated:

        sub setup {
            my $self = shift;
            $self->run_modes({
                start         => 'start',
                other_action  => 'other_method',
            });
        }
        sub start {
            my $self = shift;
            return $self->other_method;
        }
        sub other_method {
            my $self = shift;

            my $rm = $self->get_current_runmode;  # 'start'
        }

    Forward will work with coderef-based runmodes as well:

        sub setup {
            my $self = shift;
            $self->run_modes({
                start         => 'start',
                anon_action   => sub {
                    my $self = shift;
                    my $rm = $self->get_current_runmode;  # 'anon_action'
                },
            });
        }
        sub start {
            my $self = shift;
            return $self->forward('anon_action');
        }

FORWARD vs. REDIRECT
    Calling "forward" changes the run mode of your application, but it stays
    within the same HTTP request.

    To redirect to a new runmode using a completely new web request, you
    might consider using the "redirect" method provided by
    CGI::Application::Plugin::Redirect.

    The advantage of using an external redirect as opposed to an internal
    forward is that it provides a 'clean break' between pages.

    For instance, in a typical BREAD application (Browse, Read, Edit, Add,
    Delete), after the user completes an action, you usually return the user
    to the Browse list. For instance, when the user adds a new record via a
    POST form, and your app returns them to the list of records.

    If you use "forward", then you are still in the same request as the
    original *add record*. The user might hit *reload*, expecting to refresh
    the list of records. But in fact, *reload* will attempt to repost the
    *add record* form. The user's browser might present a warning about
    reposting the same data. The browser may refuse to redisplay the page,
    due for caching reasons.

    So in this case, it may make more sense to do a fresh HTTP redirect back
    to the Browse list.

METHODS
  forward
    Runs another run mode passing any parameters you supply. Returns the
    output of the new run mode.

        return $self->forward('run_mode_name', @run_mode_params);

HOOKS
    Before the forwarded run mode is called, the "forward_prerun" hook is
    called. You can use this hook to do any prep work that you want to do
    before any new run mode gains control.

    This is similar to CGI::Application's built in "cgiapp_prerun" method,
    but it is called each time you call forward; not just the when your
    application starts.

        sub setup {
            my $self = shift;
            $self->add_callback('forward_prerun' => \&prepare_rm_stuff);
        }

        sub prepare_rm_stuff {
            my $self = shift;
            # do any necessary prep work here....
        }

    Note that your hooked method will only be called when you call forward.
    If you never call "forward", the hook will not be called. In particuar,
    the hook will not be called for your application's "start_mode". For
    that, you still use "cgiapp_prerun".

    If you want to have a method run for every run mode *including* the
    "start_mode", then you can call the hook directly from "cgiapp_prerun".

        sub setup {
            my $self = shift;
            $self->add_callback('forward_prerun' => \&prepare_rm_stuff);
        }
        sub cgiapp_prerun {
            my $self = shift;
            $self->prepare_rm_stuff;
        }

        sub prepare_rm_stuff {
            my $self = shift;
            # do any necessary prep work here....
        }

    Alternately, you can hook "cgiapp_prerun" to the "forward_prerun" hook:

        sub setup {
            my $self = shift;
            $self->add_callback('forward_prerun' => \&cgiapp_prerun);
        }
        sub cgiapp_prerun {
            my $self = shift;
            # do any necessary prep work here....
        }

    This is a less flexible solution, since certain things that can be done
    in "cgiapp_prerun" (like setting "prerun_mode") won't work when the
    method is called from the "forward_prerun" hook.

AUTHOR
    Michael Graham, ""

BUGS
    Please report any bugs or feature requests to
    "bug-cgi-application-plugin-forward@rt.cpan.org", or through the web
    interface at . I will be notified, and then you'll
    automatically be notified of progress on your bug as I make changes.

ACKNOWLEDGEMENTS
    Thanks to Mark Stosberg for the idea and...well...the implementation as
    well.

COPYRIGHT & LICENSE
    Copyright 2005 Michael Graham, All Rights Reserved.

    This program is free software; you can redistribute it and/or modify it
    under the same terms as Perl itself.

CGI-Application-Plugin-Forward-1.06/Changes0100644000175200001440000000234310325063604017761 0ustar  michaelusersRevision history for CGI-Application-Plugin-Forward

1.06    October 18, 2005
        - fixed test failure due to incompatibility with new
          CAP::AutoRunmode (discovered by Shawn Sorichetti)
        - removed TODO, since everything on the list has been done

1.05    October 03, 2005
        - fixed to work with old versions of CGI::Application that don't
          support callbacks

        - now explicitly 'use CGI::Application' to make the registration
          of hooks it possible to register hooks at class load time.

        - added docs describing the difference between this module and
          CGI::Application::Plugin::Redirect, and also providng some
          notes on when to use each method.

1.04    September 15, 2005
        - actually, NOW I added the 'forward_prerun' hook
        - added support for AutoRunmode

1.03    August 23, 2005
        - added the 'forward_prerun' hook

1.02    August 1, 2005
        - added CGI::Application to the prerequisites

1.01    July 30, 2005
        - added Makefile.PL compatibility to the distribution

1.00    July 28, 2005
        - document and test support for coderef runmodes (Mark Stosberg)
        - API declared stable

0.01    July 27, 2005
        - First version

CGI-Application-Plugin-Forward-1.06/Build.PL0100644000175200001440000000120510325063604017756 0ustar  michaelusersuse strict;
use warnings;
use Module::Build;

my $builder = Module::Build->new(
    module_name         => 'CGI::Application::Plugin::Forward',
    license             => 'perl',
    dist_author         => 'Michael Graham ',
    dist_version_from   => 'lib/CGI/Application/Plugin/Forward.pm',
    requires => {
        'CGI::Application' => 0,
        'Test::More'       => 0,
    },
    recommends => {
        'CGI::Application::Plugin::AutoRunmode' => 0.09,
    },
    add_to_cleanup      => [ 'CGI-Application-Plugin-Forward-*' ],
    create_makefile_pl  => 'traditional',
);

$builder->create_build_script();
CGI-Application-Plugin-Forward-1.06/MANIFEST.SKIP0100644000175200001440000000020410325063604020356 0ustar  michaelusers^_build
^Build$
^blib
~$
\.cvsignore$
\.bak$
CVS
^cover_db
^readme.txt$
^changes.txt$
^[^/]*\.html$
\.gz$
\.tar$
^t/prereq_scenariosCGI-Application-Plugin-Forward-1.06/Makefile.PL0100644000175200001440000000072410325063604020441 0ustar  michaelusers# Note: this file was auto-generated by Module::Build::Compat version 0.03
use ExtUtils::MakeMaker;
WriteMakefile
(
          'PL_FILES' => {},
          'INSTALLDIRS' => 'site',
          'NAME' => 'CGI::Application::Plugin::Forward',
          'VERSION_FROM' => 'lib/CGI/Application/Plugin/Forward.pm',
          'PREREQ_PM' => {
                           'Test::More' => 0,
                           'CGI::Application' => 0
                         }
        )
;
CGI-Application-Plugin-Forward-1.06/META.yml0100644000175200001440000000067210325063604017742 0ustar  michaelusers---
name: CGI-Application-Plugin-Forward
version: 1.06
author:
  - Michael Graham 
abstract: Pass control from one run mode to another
license: perl
requires:
  CGI::Application: 0
  Test::More: 0
recommends:
  CGI::Application::Plugin::AutoRunmode: 0.09
provides:
  CGI::Application::Plugin::Forward:
    file: lib/CGI/Application/Plugin/Forward.pm
    version: 1.06
generated_by: Module::Build version 0.2611
CGI-Application-Plugin-Forward-1.06/MANIFEST0100644000175200001440000000053710325063604017622 0ustar  michaelusersBuild.PL
Changes
lib/CGI/Application/Plugin/Forward.pm
Makefile.PL
MANIFEST			This list of files
MANIFEST.SKIP
META.yml
misc/dist
misc/makedocs.pl
misc/module-starter-opts.txt
misc/prove_prereqs.pl
misc/style.css
README
t/00.load.t
t/01-forward.t
t/02-examples.t
t/03-coderefs.t
t/04-forward_prerun_hook.t
t/05-auto_runmode.t
t/pod-coverage.t
t/pod.t