CGI-Application-4.61 000755 001750 001750 0 13246212655 13744 5 ustar 00marto marto 000000 000000 CGI-Application-4.61/.travis.yml 000444 001750 001750 376 13246212655 16200 0 ustar 00marto marto 000000 000000 language: perl
perl:
- "5.22"
- "5.20"
- "5.18"
- "5.16"
- "5.14"
- "5.12"
- "5.10"
- "5.8"
sudo: false
before_install:
- git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers
- source ~/travis-perl-helpers/init --auto
CGI-Application-4.61/ARTISTIC 000444 001750 001750 13737 13246212655 15301 0 ustar 00marto marto 000000 000000
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
CGI-Application-4.61/Build.PL 000444 001750 001750 2230 13246212654 15371 0 ustar 00marto marto 000000 000000 use Module::Build;
my $build = Module::Build->new
(
module_name => 'CGI::Application',
license => 'perl',
requires => {
'Module::Build' => 0,
'CGI' => 4.21,
'HTML::Template' => 0,
'Test::More' => 0.47,
'Test::Requires' => 0,
'Carp' => 0,
'Class::ISA' => 0,
'Scalar::Util' => 0,
},
recommends => {
CGI::PSGI => 0.09, # If you want to use run_as_psgi()
},
'dist_author' => [
'Jesse Erlbaum ',
'Mark Stosberg ',
'Martin McGrath ',
'with the help of many others!'
],
'dist_abstract' => 'Framework for building reusable web-applications',
create_makefile_pl => 'traditional',
meta_add => {
no_index => { file => [ ] },
},
meta_merge => {
resources => {
repository => 'https://github.com/MartinMcGrath/CGI--Application',
bugtracker => 'https://github.com/MartinMcGrath/CGI--Application/issues'
},
},
);
$build->create_build_script;
CGI-Application-4.61/Changes 000444 001750 001750 44023 13246212655 15417 0 ustar 00marto marto 000000 000000 Revision history for CGI::Application.
4.61
- Release fix in 4.60_1
4.60_1
[BUGS]
- Revert MANIFEST changes which seemed to have caused some issues
https://github.com/MartinMcGrath/CGI--Application/issues/5
[DOCUMENTATION]
- Fix minor POD typo.
4.60
- Release, includes all changes from 4.50_50, 4.50_51
4.50_51 (developer release) 2015-07-16
[BUGS]
- Create new CGI::PSGI object unconditionally in psgi_app()/Bug #88506 (allter)
[DOCUMENTATION]
- Introduced Travis CI (Martin McGrath)
4.50_50 (developer release) Fri Jun 23, 2014
- Add PSGI Streaming methods (Mike Tonks)
- Added CGI.pm dependency, it is no longer a core module (Martin McGrath)
[BUGS]
- Fixed rt #84403 - Security problem: missing "start" mode dumps ENV to output page. (Martin McGrath)
- Ensure dump_html() returns valid HTML. (Martin McGrath)
[DOCUMENTATION]
- Changes to repository URL and bug tracker, added Martin McGrath as a co-maintainer
- Typo fixes (David Steinbrunner)
4.50 Thu Jun 16, 2011
[FEATURES]
Better PSGI support in the core
- run_as_psgi() works like run, but directly returns the expected PSGI response structure
- psgi_app() wraps up all the PSGI bits to call and run the application and return a PSGI
code ref:
$psgi_coderef = WebApp->psgi_app({ ... args to new() ... });
[DOCUMENTATION]
- docs for header_props() were improved
[INTERNAL]
- source control management was moved from darcs to git. Those who prefer
darcs are are more familiar with it are advised to try the darcs-git.py
wrapper for git.
- The test file psgi_app.t is missing from this release and will be added later.
4.31 Wed Jul 29, 2009
[FEATURES]
- html_tmpl_class() now allows setting an an alternate HTML::Template class
at a run time. This makes it easy to set the class to be
'HTML::Template::Dumper' for debugging. You can then see and precisely
test the Perl data structure that would be sent your template, taking
into account the template tokens that are actually set there. (Mark Stosberg)
[DOCUMENTATION]
- More typo fixes (Lyle)
4.21 Sat Jan 3, 2009
[FEATURES]
- This now works:
$webapp->query($new_query_object);
Setting a new query object can be useful in combination with
CGI::Application::Server. (Jaldhar Vyas)
[DOCUMENTATION]
- More typo fixes (Lyle)
4.20 Sat Nov 1, 2008
[DOCUMENTATION]
- typo fix (Lyle)
4.19_1 Fri Sep 27, 2008
[FEATURES]
- New 'html_tmpl_class' method allows you to specify an alternative
HTML::Template class. This technique will eliminate the need to use
a plugin for HTML::Template-compatible classes. See the docs
for load_tmpl() for details.
Thanks to Rhesa Rozendaal for the initial patch, and Mark Stosberg for
documentation refinements.
[DOCUMENTATION]
- typo fix (George Hartzell)
- Revert back to documenting the use of "$self", not $c, after community
feedback.
[INTERNALS]
- Change how default run modes are declared for better compatibility
with AutoRunmode and RunmodeDeclare plugins. Thanks Rhesa via RT#39631.
4.11 Sun Aug 10, 2008
No code changes.
[DOCUMENTATION]
- Fix POD syntax issue.
4.10 Tue Jun 17, 2008
This release maintains the same API public from 4.06. Changes since the
last stable release include documentation updates and refactors to the internal
of CGI::Application.
[DOCUMENTATION]
Several documentation improvements (Mark Stosberg)
- Reformat POD so methods are easier browse on CPAN
- Highlight some specific, common plugins to use
- Mention that we now have two CGI::App specific testing tools to use
Test::WWW::Mechanize::CGIApp and Test::WWW::Selenium::CGIApp
- Introduce and recommend CGI::Application::Dispatch
- Consolidated the documentation on error_mode()
- Split out those application methods which are essential from
those that are not.
- Use and recommend "$c" instead of "$self" to cut down on
typing for something that is abstract anyway, and represented
a simple "." in Perl 6.
- Mention CGI::Application::Server for offline website development.
- Update the introduction to clarify that we are a proven, lightweight
option.
- Removed the "experimental" flag on the error hook.
- Mention in the second Perl.com article in the "more reading" section.
- Document darcs repo URL. (Suggested by Gabor)
4.07_03 Mon Jun 16, 2008
[INTERNALS]
- The refactor to split up run() in 4.07_01 started to always pass the run mode
name as an argument to run modes. The behavior has now been reverted to
only pass the run mode name in the AUTOLOAD case. (Mark Stosberg)
[DOCUMENTATION]
- Fix typo in example. Thanks to Lesley Binks.
- document that header_props() can be usefully called with no arguments
to return the current headers. Thanks to neuhaus, RT#33992.
4.07_02 Weds Oct 31, 2007
[DOCUMENTATION]
- typo corrections (Evan Zacks)
- The docs for header_type() have been improved, including an example of using
CGI::Applicatin::Plugin::Redirect (Mark Stosberg)
[INTERNALS]
- Reverted switch to Class::MOP in 4.07_01, which benchmarking showed
to be slower. (Mark Stosberg)
- Beautify the code for _send_headers (Chris Dolan, Mark Stosberg)
4.07_01 Sun Jul 2, 2006
[INTERNALS]
- Switched from using Class::ISA to Class::MOP for introspection. Class::MOP
models the way this will be done Perl6, providing the same result. (Mark Stosberg)
- better test diagnostics (rjbs)
- improve test coverage (rjbs)
- improve consistency of checks for false/0len/undef (rjbs)
- split &run up into chunks (not yet finalized). New methods currently include:
__get_runmode
__get_runmeth
__get_body
Feedback is welcome on whether these should be exposed to the user, with
(possibly) better names. (rjbs)
4.06 Wed Apr 12, 2006
(No code changes)
- Updated tests to work with status codes emitted before and after CGI.pm 3.16.
The requirement for CGI.pm 3.16 or newer has been relaxed, so any version
of CGI.pm will do. (Rhesa)
4.05 Wed Mar 1, 2006
(No code changes)
- Updated tests for redirects to check for 'Found', not 'Moved'.
This correctly matches the standard, and was changed in CGI.pm 3.16.
As a result, we now require CGI.pm 3.16 for consistent results.
4.04 Wed Oct 11, 2005
- No code changes since 4.04_02. Declaring stable.
4.04_02 Thu Sep 8, 2005
- Add support for templates stored in file handles and scalarrefs to load_tmpl().
(Jason Purdy)
4.04_01 Wed Aug 31, 2005
- move load_tmpl hook to after we build $tmpl_file so it will always have a
(probably) valid file to work with.
- initial support for a default template name in load_tmpl(). That means
you can now do this:
my $t = $self->load_tmpl();
And it will default to a file named after the current run mode with a
.html extension.
4.03 Thu Aug 04, 2005
- Fixed important bug introduced in 4.02 in which a mode_param
set in a sub-class would have been ignored. A new automated test
was added to prevent this regression in the future.
4.02 Sat Jul 30, 2005
- Documented existence of CGI::Application::Plugin::FillInForm.
- path_info option to mode_param now supports negative index numbers
to grab the run mode name from the other end of the PATH_INFO.
(Thilo Planz)
- Altered how "start_mode" default is set, allowing it to be set
through the hook system in the 'init' phase. Existing applications
should be unaffected.
- Return value of run_modes() was documented.
- Integrate more examples of using plugins into the documentation.
- 'error' hook was added, which is executed just before error_mode() might
be called. An example use of this would be a logging plugin that wants to
log that the application died. Although it's unlikely to change, it is marked
as experimental for now.
4.01 Tue Jun 14, 2005
NOTE: This release has an important incompatibility from the 4.0 release
two days ago. The 'load_tmpl' hook which was just introduced has had it's
interface changed. The change allows plug-in authors to affect the parameters
passed to the 'new' constructor of the template object, instead of just adding
parameters later.
4.0 Fri Jun 10, 2005
This release adds a major new feature of special interest to plugin
authors: 'hooks'. This concept helps to create plugins that are more powerful
and simpler to use for end users. See the documentation on writing plugins for
details.
Special thanks to Cees Hek and Michael Graham for their effort to develop
and refine the hook system.
Since the last major release, there has been an explosion of new plugins
developed. This is an incomplete list of modules below the
'CGI::Application::Plugin' namespace. Expect more to be added and updated soon
with the advent of the hook system:
::AnyTemplate - Use any templating system with a unified interface
::Apache - Use Apache::* modules without interference
::AutoRunmode - Automatically register runmodes
::ConfigAuto - Integration with Config::Auto
::Config::Context - Integration with Config::Context
::Config::General - Integration with Config::General
::Config::Simple - Integration with Config::Simple
::CompressGzip - Add Gzip compression
::DBH - Integration with DBI
::LogDispatch - Integration with Log::Dispatch
::Session - Integration with CGI::Session
::Stream - Help stream files to the browser
::TT - Use Template::Toolkit as an alternative to HTML::Template
::ValidateRM - Integration with Data::FormValidator and HTML::FillInForm
The following additional changes are also present in this release:
- Enhanced tests and documentation for error_mode(). (Rob Kinyon).
- Clarified Plug-in documentation (Timothy Appnel)
- Avoid some warnings when getting run mode from PATH_INFO (Emanuele Zeppieri)
- Use query() object to get PATH_INFO, to workaround bug in IIS web server. (Mark Stosberg)
- Documented return value of header_props()
3.31 Sun Sep 26, 2004
- Documentation clean-ups. No code changes.
3.30 Sun Sep 26, 2004
- Refactored test suite to use Test::More (Gabor Szabo)
- Removed warnings being emitted for documented API calls
- minor code clean-up to load_tmpl() (Emanuele Zeppieri)
- Support for passing multiple template paths to HTML::Template (Michael Peters)
- Added error_mode to support trapping runmodes dying (Rob Kinyon)
- Added Plug-in related documentation. (Mark Stosberg)
- mode_param() updated to more easily set the run mode from $ENV{PATH_INFO} (Mark Stosberg)
3.22 Fri Feb 13, 2004
- The nocgicarp flag introduced in 3.2 has now been removed due
to ill importing side effects. Instead, we now simply use Carp
instead of CGI::Carp. You must now explicitly load CGI::Carp if you want
it. Any code that used the brief-lived 'nocgicarp' feature will need to
be updated.
- Support for run modes named '0'. (Josh Glover)
3.21 Wed Feb 4, 2004
- Updated some header tests to be compatible with old and new versions of CGI.pm, which
handled the capitalization of the header differently. (Mark Stosberg)
3.2 Sat Jan 31, 2004
- header_add() has been added to allow setting extra headers, particularly cookies,
after header_props has already been called (Cees Hek, Mark Stosberg)
- CGI::Carp is now optional. See docs for details. (Steve Hay)
- Avoid 'unitialized value' warning on redirects (Cees Hek)
- Some tests added (Mark Stosberg)
- Updated documentation to use term "Run Mode" consistently, versus "Run-Mode" with
a dash. Run-mode-with-a-dash is dead. Don't revive it. Also added mentions
of the CGI::Application wiki and CGI::Application::ValidateRM
(Mark Stosberg)
- Fixed typo in cgiapp_postrun documentation (Steve Hay)
- Improved exception handling (Steve Hay)
- delete() method added to remove items stored using param() (Michael Peters)
- 'CGI_APP_RETURN_ONLY' environment variable that is used for testing is now
documented (Michael Peters)
- dump_html() is now properly HTML-escaped (podmaster, Brian Cassidy)
- Migrated from Makefile.PL to Build.PL. Either can now be used for installation.
- Updated 'Changes' file to put new releases on top.
3.1 Mon Jun 2 07:54:31 EDT 2003
- Changed dump_html default run mode to be referenced by name
instead of sub-ref. This allows dump_html() to be overridden
in sub-class.
- Added current run mode to output of dump() and dump_html().
(Thanks to Mark Stosberg for the suggestion.)
- Added example of doing an HTTP redirect (suggested by Sam Tregar)
- Fixed bug where non-CGI.pm query objects couldn't be set
at initialization time via the new() method. (Thanks to Steve
Hay for the catch.)
- Added header_type("none") to surpress HTTP header output.
(Thanks to Steve Comrie for the suggestion.)
- Numerous typos corrected in POD.
- Added cgiapp_postrun() hook. This hook allows run mode output
to be "pipelined" through optional filters, modifying the
content and HTTP headers if so desired.
3.0 Sat Feb 1 02:27:19 EST 2003
- Changed run_modes() method to allow list of run modes to be
designated via an array reference. This will automatically
create a run modes table which maps from a run mode to a
run mode method of the same name. Bumped major revision
number to reflect this significant change in functionality.
- Clarified license for module (GPL or Artistic). Included
licenses in distribution package.
2.6 Mon Oct 7 07:34:35 EDT 2002
- Changed the run() method to use Perl's built-in dynamic method
call for all run modes, whether by name or by code ref. This
is intended to improve run-time performance somewhat. Thanks
to Darin McBride for this patch.
- Added new override-able method cgiapp_get_query(). This method
is called when CGI::Application first needs access to the CGI
query object. By default, this is a CGI.pm object. It is
possible to override the cgiapp_get_query() method to return
an object of some other module besides CGI.pm, providing
that it is sufficiently compatible. Thanks to Eric Andreychek
for the suggestion and his help troubleshooting the code.
2.5 Thu Jul 18 07:45:47 EDT 2002
- Changed mailing list address. The new mailing list address.
To subscribe: cgiapp-subscribe@lists.erlbaum.net
To post message: cgiapp@lists.erlbaum.net
2.4 Sat May 25 13:32:44 EDT 2002
- Modified tmpl_path() to propagate to HTML::Template's PATH
parameter. This provides much more useful and intuitive
behavior. Thanks to Sam Tregar for the patch!
- Added prerun_mode() method to allow the run mode to be
dynamically changed inside the cgiapp_prerun() method.
Thanks to Steve Comrie for the suggestion of using a
method call for this function. Thanks to many other list
members for further refining this idea.
- Refactored some test cases, general code clean-up.
- Refactored POD a bit to make it less intimidating for
new users.
2.3 Mon May 6 07:12:09 EDT 2002
- Fixed minor bug in build system for older Perl versions.
2.2 Sun Aug 19 12:20:21 EDT 2001
- Added new module CGI::Application::Mailform as both an
example of how to use CGI::Application and a useful
(albeit simple) reusable web-based application.
- CGI::Application::Mailform allows the contents of
data submitted through HTML forms to be easily sent
via email to a specified recipient. This application
is intended to be very easy to reuse, yet secure
and functional enough to replace some of the most
onerous "mailform" scripts which have been floating
around the Internet for ages.
- Added cgiapp_prerun() hook, for adding global behaviors
before the run mode method is called. The cgiapp_prerun()
gets the name of the run mode as a parameter. This would
allow the user to perform some action based on the
current run mode.
2.1 Sat Aug 11 12:57:49 EDT 2001
- The param() method has been extended to allow multiple parameters
to be set at one time, via a hash (or hashref).
- Fixed bug in run() method where a null-string run mode would be
considered valid. A zero-length run mode will now result in the
start_mode() being called.
(Thanks to Mark Stosberg for the two preceding ideas!)
- The run_mode() method now may be called a subsequent time to
amend the list of run modes.
2.0 Sun Jun 24 23:01:58 EDT 2001
- Added ability to set mode_param() to use a call-back instance method
(specified by subref) instead of a CGI parameter.
- HTML::Template is now only loaded if load_tmpl() is called.
(Thanks to Stephen Howard for the two preceding ideas!)
- Run modes may now return scalar-refs in addition to scalars.
- Added new run mode of last resort: "AUTOLOAD". See POD for usage.
- Updated MAJOR REVISION number to 2 -- new functionality deserves it.
1.31 Mon May 28 14:06:16 EDT 2001
- Updated docs to favor new name-based run mode method references.
1.3 Sun May 20 18:48:36 EDT 2001
- Enhanced capabilities for creating general superclasses for your projects.
- All run modes may be referenced by method name, in addition to subref.
- Created cgiapp_init() hook to allow for inherited common behaviors.
- Fixed minor bugs in default values.
1.2 Fri Jul 14 01:49:30 EDT 2000
- Modified load_tmpl() to pass extra params to HTML::Template->new_file().
- Fixed up the docs a bit.
- Minor code clean-up.
1.1 Tue Jul 11 22:59:17 EDT 2000
- Tweaked test.pl to avoid CGI.pm command line debugging interface
which requires user to hit CTRL-D to continue
- Added ANNOUNCE file.
1.0 Mon Jul 10 23:47:30 2000
- Release 1.0 complete. Woohoo!
0.01 Mon Jul 3 20:40:30 2000
- original version; created by h2xs 1.19
CGI-Application-4.61/GPL 000444 001750 001750 43101 13246212654 14464 0 ustar 00marto marto 000000 000000 GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C) 19yy
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.
CGI-Application-4.61/MANIFEST 000444 001750 001750 1477 13246212655 15243 0 ustar 00marto marto 000000 000000 .travis.yml
lib/CGI/Application.pm
lib/CGI/Application/Mailform.pm
ARTISTIC
Changes
Examples/Mailform/README
Examples/Mailform/mailform.cgi
Examples/Mailform/mailform.html
Examples/Mailform/thankyou.html
GPL
MANIFEST
META.yml
Build.PL
Makefile.PL
README
t/basic.t
t/default_runmode.t
t/mailform.t
t/prerun.t
t/getquery.t
t/header_props.t
t/arrayrefmodes.t
t/enhancement31.t
t/postrun.t
t/zerorm.t
t/errormode.t
t/callbacks.t
t/mode_param_path_info.t
t/mode_param_overwritten.t
t/load_tmpl_hook.t
t/query.t
t/run_as_psgi.t
t/lib/TestApp.pm
t/lib/TestApp2.pm
t/lib/TestApp3.pm
t/lib/TestApp4.pm
t/lib/TestApp5.pm
t/lib/TestApp6.pm
t/lib/TestApp7.pm
t/lib/TestApp8.pm
t/lib/TestApp9.pm
t/lib/TestApp10.pm
t/lib/TestApp11.pm
t/lib/TestApp12.pm
t/lib/TestApp13.pm
t/lib/TestApp14.pm
t/lib/TestCGI.pm
t/lib/templates/test.tmpl
META.json
CGI-Application-4.61/META.json 000444 001750 001750 3316 13246212654 15524 0 ustar 00marto marto 000000 000000 {
"abstract" : "Framework for building reusable web-applications",
"author" : [
"Jesse Erlbaum ",
"Mark Stosberg ",
"Martin McGrath ",
"with the help of many others!"
],
"dynamic_config" : 1,
"generated_by" : "Module::Build version 0.4216",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "CGI-Application",
"no_index" : {
"file" : []
},
"prereqs" : {
"configure" : {
"requires" : {
"Module::Build" : "0.42"
}
},
"runtime" : {
"recommends" : {
"CGI::PSGI" : "0.09"
},
"requires" : {
"CGI" : "4.21",
"Carp" : "0",
"Class::ISA" : "0",
"HTML::Template" : "0",
"Module::Build" : "0",
"Scalar::Util" : "0",
"Test::More" : "0.47",
"Test::Requires" : "0"
}
}
},
"provides" : {
"CGI::Application" : {
"file" : "lib/CGI/Application.pm",
"version" : "4.61"
},
"CGI::Application::Mailform" : {
"file" : "lib/CGI/Application/Mailform.pm"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/MartinMcGrath/CGI--Application/issues"
},
"license" : [
"http://dev.perl.org/licenses/"
],
"repository" : {
"url" : "https://github.com/MartinMcGrath/CGI--Application"
}
},
"version" : "4.61",
"x_serialization_backend" : "JSON::PP version 2.27300"
}
CGI-Application-4.61/META.yml 000444 001750 001750 2212 13246212654 15346 0 ustar 00marto marto 000000 000000 ---
abstract: 'Framework for building reusable web-applications'
author:
- 'Jesse Erlbaum '
- 'Mark Stosberg '
- 'Martin McGrath '
- 'with the help of many others!'
build_requires: {}
configure_requires:
Module::Build: '0.42'
dynamic_config: 1
generated_by: 'Module::Build version 0.4216, CPAN::Meta::Converter version 2.150005'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: CGI-Application
no_index:
file: []
provides:
CGI::Application:
file: lib/CGI/Application.pm
version: '4.61'
CGI::Application::Mailform:
file: lib/CGI/Application/Mailform.pm
recommends:
CGI::PSGI: '0.09'
requires:
CGI: '4.21'
Carp: '0'
Class::ISA: '0'
HTML::Template: '0'
Module::Build: '0'
Scalar::Util: '0'
Test::More: '0.47'
Test::Requires: '0'
resources:
bugtracker: https://github.com/MartinMcGrath/CGI--Application/issues
license: http://dev.perl.org/licenses/
repository: https://github.com/MartinMcGrath/CGI--Application
version: '4.61'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
CGI-Application-4.61/Makefile.PL 000444 001750 001750 1153 13246212654 16052 0 ustar 00marto marto 000000 000000 # Note: this file was auto-generated by Module::Build::Compat version 0.4216
use ExtUtils::MakeMaker;
WriteMakefile
(
'NAME' => 'CGI::Application',
'VERSION_FROM' => 'lib/CGI/Application.pm',
'PREREQ_PM' => {
'CGI' => '4.21',
'Carp' => 0,
'Class::ISA' => 0,
'HTML::Template' => 0,
'Module::Build' => 0,
'Scalar::Util' => 0,
'Test::More' => '0.47',
'Test::Requires' => 0
},
'INSTALLDIRS' => 'site',
'EXE_FILES' => [],
'PL_FILES' => {}
)
;
CGI-Application-4.61/README 000444 001750 001750 4173 13246212654 14765 0 ustar 00marto marto 000000 000000 #########################################################################
## CGI::Application - Framework for building reusable web-applications ##
#########################################################################
CGI::Application is intended to make it easier to create sophisticated,
reusable web-based applications. This module implements a methodology which,
if followed, will make your web software easier to design, easier to
document, easier to write, and easier to evolve.
Download site for CGI::Application:
http://search.cpan.org/dist/CGI-Application/
See the 'Changes' file for recent changes.
For more information about this module, please see our website at:
http://www.cgi-app.org/
HOW DO I INSTALL IT?
To install this module, cd to the directory that contains this README
file and type the following:
perl Build.PL
./Build
./Build test
./Build install
CGI::Application builds on standard, non-proprietary technologies and
techniques, such as the Common Gateway Interface and Lincoln D. Stein's
excellent CGI.pm module. CGI::Application judiciously avoids employing
technologies and techniques which would bind a developer to any one set
of tools, operating system or web server.
The guiding philosophy behind CGI::Application is that a web-based
application can be organized into a specific set of "Run Modes." Each
Run Mode is roughly analogous to a single screen (a form, some output, etc).
All the Run Modes are managed by a single "Application Module" which is a
Perl module. In your web server's document space there is an "Instance
Script" which is called by the web server as a CGI (or an Apache::Registry
script if you're using Apache + mod_perl).
CGI::Application is an Object-Oriented Perl module which implements an
Abstract Class. It is not intended that this package be instantiated
directly. Instead, it is intended that your Application Module will be
implemented as a Sub-Class of CGI::Application.
If you have any questions, comments, bug reports or feature suggestions,
post them to the support mailing list! To join the mailing list, visit
http://lists.openlib.org/mailman/listinfo/cgiapp
CGI-Application-4.61/Examples 000755 001750 001750 0 13246212654 15521 5 ustar 00marto marto 000000 000000 CGI-Application-4.61/Examples/Mailform 000755 001750 001750 0 13246212655 17270 5 ustar 00marto marto 000000 000000 CGI-Application-4.61/Examples/Mailform/README 000444 001750 001750 573 13246212655 20272 0 ustar 00marto marto 000000 000000 The files in this directory are an example of how to use
CGI::Application::Mailform, which is provided as a part
of CGI::Application. The example files are as follows:
mailform.html -- The HTML form.
mailform.cgi -- The instance script.
thankyou.html -- The thank-you HTML page.
Please refer to the POD for CGI::Application::Mailform
for details on its usage.
CGI-Application-4.61/Examples/Mailform/mailform.cgi 000444 001750 001750 2617 13246212654 21724 0 ustar 00marto marto 000000 000000 #!/usr/bin/perl -w
#### INCLUDE MAILFORM MODULE ###########################################
#
use CGI::Application::Mailform;
#### INSTANTIATE NEW MAILFORM OBJECT ###################################
#
my $mf = CGI::Application::Mailform->new();
#### SET REQUIRED VARIABLES ############################################
#
$mf->param( 'MAIL_TO' => 'jesse-cgiappmf@erlbaum.net' );
$mf->param( 'MAIL_FROM' =>
$ENV{SERVER_ADMIN} ||
($ENV{USER} || 'webmaster') . '@' . ($ENV{HOSTNAME} || $ENV{SERVER_NAME}) );
$mf->param( 'HTMLFORM_REDIRECT_URL' => 'mailform.html' );
$mf->param( 'SUCCESS_REDIRECT_URL' => 'thankyou.html' );
$mf->param( 'FORM_FIELDS' => [qw/
company_name
email
mailform_is
name
perl_is
postal_address
sing_happy_bday /] );
#### SET OPTIONAL VARIABLES ############################################
#
$mf->param('SUBJECT' => 'Another happy CGI::Application::Mailform user!');
$mf->param('ENV_FIELDS' => [qw/
AUTH_TYPE
CONTENT_LENGTH
CONTENT_TYPE
GATEWAY_INTERFACE
HTTP_ACCEPT
HTTP_USER_AGENT
PATH_INFO
PATH_TRANSLATED
QUERY_STRING
REMOTE_ADDR
REMOTE_HOST
REMOTE_IDENT
REMOTE_USER
REQUEST_METHOD
SCRIPT_NAME
SERVER_NAME
SERVER_PORT
SERVER_PROTOCOL
SERVER_SOFTWARE /]);
#### RUN MAILFORM ######################################################
#
$mf->run();
#### ALL DONE! #########################################################
#
exit(0);
CGI-Application-4.61/Examples/Mailform/mailform.html 000444 001750 001750 5270 13246212654 22124 0 ustar 00marto marto 000000 000000
CGI::Application::Mailform Example
CGI::Application::Mailform Example
A simple HTML form to email system.
CGI::Application::Mailform is a subclass of CGI::Application. CGI::Application and
CGI::Application::Mailform are Perl modules written by Jesse Erlbaum and
are available at http://www.cpan.org/authors/id/J/JE/JERLBAUM/
CGI-Application-4.61/Examples/Mailform/thankyou.html 000444 001750 001750 744 13246212654 22141 0 ustar 00marto marto 000000 000000
Thanks for your submission!
Thanks for your submission!
Your data has been submitted to the FBI, CIA and NSA. They have traced your location via laser satellite, and the black helecopters are enroute. Please watch network televison until they arrive, so they may more easily read your mind.*
(*Your CGI::Application::Mailform has worked! And, the helecopters are actually invisible.)
CGI-Application-4.61/lib 000755 001750 001750 0 13246212654 14511 5 ustar 00marto marto 000000 000000 CGI-Application-4.61/lib/CGI 000755 001750 001750 0 13246212655 15114 5 ustar 00marto marto 000000 000000 CGI-Application-4.61/lib/CGI/Application.pm 000444 001750 001750 237430 13246212655 20123 0 ustar 00marto marto 000000 000000 package CGI::Application;
use Carp;
use strict;
use Class::ISA;
use Scalar::Util;
$CGI::Application::VERSION = '4.61';
my %INSTALLED_CALLBACKS = (
# hook name package sub
init => { 'CGI::Application' => [ 'cgiapp_init' ] },
prerun => { 'CGI::Application' => [ 'cgiapp_prerun' ] },
postrun => { 'CGI::Application' => [ 'cgiapp_postrun' ] },
teardown => { 'CGI::Application' => [ 'teardown' ] },
load_tmpl => { },
error => { },
);
###################################
#### INSTANCE SCRIPT METHODS ####
###################################
sub new {
my $class = shift;
my @args = @_;
if (ref($class)) {
# No copy constructor yet!
$class = ref($class);
}
# Create our object!
my $self = {};
bless($self, $class);
### SET UP DEFAULT VALUES ###
#
# We set them up here and not in the setup() because a subclass
# which implements setup() still needs default values!
$self->header_type('header');
$self->mode_param('rm');
$self->start_mode('start');
# Process optional new() parameters
my $rprops;
if (ref($args[0]) eq 'HASH') {
$rprops = $self->_cap_hash($args[0]);
} else {
$rprops = $self->_cap_hash({ @args });
}
# Set tmpl_path()
if (exists($rprops->{TMPL_PATH})) {
$self->tmpl_path($rprops->{TMPL_PATH});
}
# Set CGI query object
if (exists($rprops->{QUERY})) {
$self->query($rprops->{QUERY});
}
# Set up init param() values
if (exists($rprops->{PARAMS})) {
croak("PARAMS is not a hash ref") unless (ref($rprops->{PARAMS}) eq 'HASH');
my $rparams = $rprops->{PARAMS};
while (my ($k, $v) = each(%$rparams)) {
$self->param($k, $v);
}
}
# Lock prerun_mode from being changed until cgiapp_prerun()
$self->{__PRERUN_MODE_LOCKED} = 1;
# Call cgiapp_init() method, which may be implemented in the sub-class.
# Pass all constructor args forward. This will allow flexible usage
# down the line.
$self->call_hook('init', @args);
# Call setup() method, which should be implemented in the sub-class!
$self->setup();
return $self;
}
sub __get_runmode {
my $self = shift;
my $rm_param = shift;
my $rm;
# Support call-back instead of CGI mode param
if (ref($rm_param) eq 'CODE') {
# Get run mode from subref
$rm = $rm_param->($self);
}
# support setting run mode from PATH_INFO
elsif (ref($rm_param) eq 'HASH') {
$rm = $rm_param->{run_mode};
}
# Get run mode from CGI param
else {
$rm = $self->query->param($rm_param);
}
# If $rm undefined, use default (start) mode
$rm = $self->start_mode unless defined($rm) && length($rm);
return $rm;
}
sub __get_runmeth {
my $self = shift;
my $rm = shift;
my $rmeth;
my $is_autoload = 0;
my %rmodes = ($self->run_modes());
if (exists($rmodes{$rm})) {
$rmeth = $rmodes{$rm};
}
else {
# Look for run mode "AUTOLOAD" before dieing
unless (exists($rmodes{'AUTOLOAD'})) {
croak("No such run mode '$rm'");
}
$rmeth = $rmodes{'AUTOLOAD'};
$is_autoload = 1;
}
return ($rmeth, $is_autoload);
}
sub __get_body {
my $self = shift;
my $rm = shift;
my ($rmeth, $is_autoload) = $self->__get_runmeth($rm);
my $body;
eval {
$body = $is_autoload ? $self->$rmeth($rm) : $self->$rmeth();
};
if ($@) {
my $error = $@;
$self->call_hook('error', $error);
if (my $em = $self->error_mode) {
$body = $self->$em( $error );
} else {
croak("Error executing run mode '$rm': $error");
}
}
# Make sure that $body is not undefined (suppress 'uninitialized value'
# warnings)
return defined $body ? $body : '';
}
sub run {
my $self = shift;
my $q = $self->query();
my $rm_param = $self->mode_param();
my $rm = $self->__get_runmode($rm_param);
# Set get_current_runmode() for access by user later
$self->{__CURRENT_RUNMODE} = $rm;
# Allow prerun_mode to be changed
delete($self->{__PRERUN_MODE_LOCKED});
# Call PRE-RUN hook, now that we know the run mode
# This hook can be used to provide run mode specific behaviors
# before the run mode actually runs.
$self->call_hook('prerun', $rm);
# Lock prerun_mode from being changed after cgiapp_prerun()
$self->{__PRERUN_MODE_LOCKED} = 1;
# If prerun_mode has been set, use it!
my $prerun_mode = $self->prerun_mode();
if (length($prerun_mode)) {
$rm = $prerun_mode;
$self->{__CURRENT_RUNMODE} = $rm;
}
# Process run mode!
my $body = $self->__get_body($rm);
# Support scalar-ref for body return
$body = $$body if ref $body eq 'SCALAR';
# Call cgiapp_postrun() hook
$self->call_hook('postrun', \$body);
my $return_value;
if ($self->{__IS_PSGI}) {
my ($status, $headers) = $self->_send_psgi_headers();
if (ref($body) eq 'GLOB' || (Scalar::Util::blessed($body) && $body->can('getline'))) {
# body a file handle - return it
$return_value = [ $status, $headers, $body];
}
elsif (ref($body) eq 'CODE') {
# body is a subref, or an explicit callback method is set
$return_value = sub {
my $respond = shift;
my $writer = $respond->([ $status, $headers ]);
&$body($writer);
};
}
else {
$return_value = [ $status, $headers, [ $body ]];
}
}
else {
# Set up HTTP headers non-PSGI responses
my $headers = $self->_send_headers();
# Build up total output
$return_value = $headers.$body;
print $return_value unless $ENV{CGI_APP_RETURN_ONLY};
}
# clean up operations
$self->call_hook('teardown');
return $return_value;
}
sub psgi_app {
my $class = shift;
my $args_to_new = shift;
return sub {
my $env = shift;
# PR from alter https://github.com/markstos/CGI--Application/pull/17
#if (not defined $args_to_new->{QUERY}) {
require CGI::PSGI;
$args_to_new->{QUERY} = CGI::PSGI->new($env);
#}
my $webapp = $class->new($args_to_new);
return $webapp->run_as_psgi;
}
}
sub run_as_psgi {
my $self = shift;
$self->{__IS_PSGI} = 1;
# Run doesn't officially support any args, but pass them through in case some sub-class uses them.
return $self->run(@_);
}
############################
#### OVERRIDE METHODS ####
############################
sub cgiapp_get_query {
my $self = shift;
# Include CGI.pm and related modules
require CGI;
# Get the query object
my $q = CGI->new();
return $q;
}
sub cgiapp_init {
my $self = shift;
my @args = (@_);
# Nothing to init, yet!
}
sub cgiapp_prerun {
my $self = shift;
my $rm = shift;
# Nothing to prerun, yet!
}
sub cgiapp_postrun {
my $self = shift;
my $bodyref = shift;
# Nothing to postrun, yet!
}
sub setup {
my $self = shift;
}
sub teardown {
my $self = shift;
# Nothing to shut down, yet!
}
######################################
#### APPLICATION MODULE METHODS ####
######################################
sub dump {
my $self = shift;
my $output = '';
# Dump run mode
my $current_runmode = $self->get_current_runmode();
$current_runmode = "" unless (defined($current_runmode));
$output .= "Current Run mode: '$current_runmode'\n";
# Dump Params
# updated ->param to ->multi_param to silence CGI.pm warning
$output .= "\nQuery Parameters:\n";
my @params = $self->query->multi_param();
foreach my $p (sort(@params)) {
my @data = $self->query->multi_param($p);
my $data_str = "'".join("', '", @data)."'";
$output .= "\t$p => $data_str\n";
}
# Dump ENV
$output .= "\nQuery Environment:\n";
foreach my $ek (sort(keys(%ENV))) {
$output .= "\t$ek => '".$ENV{$ek}."'\n";
}
return $output;
}
sub dump_html {
my $self = shift;
my $query = $self->query();
my $output = '';
# Dump run-mode
my $current_runmode = $self->get_current_runmode();
$output .= "
};
$output .= $query->end_html();
return $output;
}
sub header_add {
my $self = shift;
return $self->_header_props_update(\@_,add=>1);
}
sub header_props {
my $self = shift;
return $self->_header_props_update(\@_,add=>0);
}
# used by header_props and header_add to update the headers
sub _header_props_update {
my $self = shift;
my $data_ref = shift;
my %in = @_;
my @data = @$data_ref;
# First use? Create new __HEADER_PROPS!
$self->{__HEADER_PROPS} = {} unless (exists($self->{__HEADER_PROPS}));
my $props;
# If data is provided, set it!
if (scalar(@data)) {
if ($self->header_type eq 'none') {
warn "header_props called while header_type set to 'none', headers will NOT be sent!"
}
# Is it a hash, or hash-ref?
if (ref($data[0]) eq 'HASH') {
# Make a copy
%$props = %{$data[0]};
} elsif ((scalar(@data) % 2) == 0) {
# It appears to be a possible hash (even # of elements)
%$props = @data;
} else {
my $meth = $in{add} ? 'add' : 'props';
croak("Odd number of elements passed to header_$meth(). Not a valid hash")
}
# merge in new headers, appending new values passed as array refs
if ($in{add}) {
for my $key_set_to_aref (grep { ref $props->{$_} eq 'ARRAY'} keys %$props) {
my $existing_val = $self->{__HEADER_PROPS}->{$key_set_to_aref};
next unless defined $existing_val;
my @existing_val_array = (ref $existing_val eq 'ARRAY') ? @$existing_val : ($existing_val);
$props->{$key_set_to_aref} = [ @existing_val_array, @{ $props->{$key_set_to_aref} } ];
}
$self->{__HEADER_PROPS} = { %{ $self->{__HEADER_PROPS} }, %$props };
}
# Set new headers, clobbering existing values
else {
$self->{__HEADER_PROPS} = $props;
}
}
# If we've gotten this far, return the value!
return (%{ $self->{__HEADER_PROPS}});
}
sub header_type {
my $self = shift;
my ($header_type) = @_;
my @allowed_header_types = qw(header redirect none);
# First use? Create new __HEADER_TYPE!
$self->{__HEADER_TYPE} = 'header' unless (exists($self->{__HEADER_TYPE}));
# If data is provided, set it!
if (defined($header_type)) {
$header_type = lc($header_type);
croak("Invalid header_type '$header_type'")
unless(grep { $_ eq $header_type } @allowed_header_types);
$self->{__HEADER_TYPE} = $header_type;
}
# If we've gotten this far, return the value!
return $self->{__HEADER_TYPE};
}
sub param {
my $self = shift;
my (@data) = (@_);
# First use? Create new __PARAMS!
$self->{__PARAMS} = {} unless (exists($self->{__PARAMS}));
my $rp = $self->{__PARAMS};
# If data is provided, set it!
if (scalar(@data)) {
# Is it a hash, or hash-ref?
if (ref($data[0]) eq 'HASH') {
# Make a copy, which augments the existing contents (if any)
%$rp = (%$rp, %{$data[0]});
} elsif ((scalar(@data) % 2) == 0) {
# It appears to be a possible hash (even # of elements)
%$rp = (%$rp, @data);
} elsif (scalar(@data) > 1) {
croak("Odd number of elements passed to param(). Not a valid hash");
}
} else {
# Return the list of param keys if no param is specified.
return (keys(%$rp));
}
# If exactly one parameter was sent to param(), return the value
if (scalar(@data) <= 2) {
my $param = $data[0];
return $rp->{$param};
}
return; # Otherwise, return undef
}
sub delete {
my $self = shift;
my ($param) = @_;
# return undef it the param name isn't given
return undef unless defined $param;
#simply delete this param from $self->{__PARAMS}
delete $self->{__PARAMS}->{$param};
}
sub query {
my $self = shift;
my ($query) = @_;
# If data is provided, set it! Otherwise, create a new one.
if (defined($query)) {
$self->{__QUERY_OBJ} = $query;
} else {
# We're only allowed to create a new query object if one does not yet exist!
unless (exists($self->{__QUERY_OBJ})) {
$self->{__QUERY_OBJ} = $self->cgiapp_get_query();
}
}
return $self->{__QUERY_OBJ};
}
sub run_modes {
my $self = shift;
my (@data) = (@_);
# First use? Create new __RUN_MODES!
$self->{__RUN_MODES} = { 'start' => 'no_runmodes' } unless (exists($self->{__RUN_MODES}));
my $rr_m = $self->{__RUN_MODES};
# If data is provided, set it!
if (scalar(@data)) {
# Is it a hash, hash-ref, or array-ref?
if (ref($data[0]) eq 'HASH') {
# Make a copy, which augments the existing contents (if any)
%$rr_m = (%$rr_m, %{$data[0]});
} elsif (ref($data[0]) eq 'ARRAY') {
# Convert array-ref into hash table
foreach my $rm (@{$data[0]}) {
$rr_m->{$rm} = $rm;
}
} elsif ((scalar(@data) % 2) == 0) {
# It appears to be a possible hash (even # of elements)
%$rr_m = (%$rr_m, @data);
} else {
croak("Odd number of elements passed to run_modes(). Not a valid hash");
}
}
# If we've gotten this far, return the value!
return (%$rr_m);
}
sub start_mode {
my $self = shift;
my ($start_mode) = @_;
# First use? Create new __START_MODE
$self->{__START_MODE} = 'start' unless (exists($self->{__START_MODE}));
# If data is provided, set it
if (defined($start_mode)) {
$self->{__START_MODE} = $start_mode;
}
return $self->{__START_MODE};
}
sub error_mode {
my $self = shift;
my ($error_mode) = @_;
# First use? Create new __ERROR_MODE
$self->{__ERROR_MODE} = undef unless (exists($self->{__ERROR_MODE}));
# If data is provided, set it.
if (defined($error_mode)) {
$self->{__ERROR_MODE} = $error_mode;
}
return $self->{__ERROR_MODE};
}
sub tmpl_path {
my $self = shift;
my ($tmpl_path) = @_;
# First use? Create new __TMPL_PATH!
$self->{__TMPL_PATH} = '' unless (exists($self->{__TMPL_PATH}));
# If data is provided, set it!
if (defined($tmpl_path)) {
$self->{__TMPL_PATH} = $tmpl_path;
}
# If we've gotten this far, return the value!
return $self->{__TMPL_PATH};
}
sub prerun_mode {
my $self = shift;
my ($prerun_mode) = @_;
# First use? Create new __PRERUN_MODE
$self->{__PRERUN_MODE} = '' unless (exists($self->{__PRERUN_MODE}));
# Was data provided?
if (defined($prerun_mode)) {
# Are we allowed to set prerun_mode?
if (exists($self->{__PRERUN_MODE_LOCKED})) {
# Not allowed! Throw an exception.
croak("prerun_mode() can only be called within cgiapp_prerun()! Error");
} else {
# If data is provided, set it!
$self->{__PRERUN_MODE} = $prerun_mode;
}
}
# If we've gotten this far, return the value!
return $self->{__PRERUN_MODE};
}
sub get_current_runmode {
my $self = shift;
# It's OK if we return undef if this method is called too early
return $self->{__CURRENT_RUNMODE};
}
###########################
#### PRIVATE METHODS ####
###########################
# return headers as a string
sub _send_headers {
my $self = shift;
my $q = $self->query;
my $type = $self->header_type;
return
$type eq 'redirect' ? $q->redirect( $self->header_props )
: $type eq 'header' ? $q->header ( $self->header_props )
: $type eq 'none' ? ''
: croak "Invalid header_type '$type'"
}
# return a 2 element array modeling the first PSGI redirect values: status code and arrayref of header pairs
sub _send_psgi_headers {
my $self = shift;
my $q = $self->query;
my $type = $self->header_type;
return
$type eq 'redirect' ? $q->psgi_redirect( $self->header_props )
: $type eq 'header' ? $q->psgi_header ( $self->header_props )
: $type eq 'none' ? ''
: croak "Invalid header_type '$type'"
}
# Make all hash keys CAPITAL
# although this method is internal, some other extensions
# have come to rely on it, so any changes here should be
# made with great care or avoided.
sub _cap_hash {
my $self = shift;
my $rhash = shift;
my %hash = map {
my $k = $_;
my $v = $rhash->{$k};
$k =~ tr/a-z/A-Z/;
$k => $v;
} keys(%{$rhash});
return \%hash;
}
1;
=pod
=head1 NAME
CGI::Application - Framework for building reusable web-applications
=head1 SYNOPSIS
# In "WebApp.pm"...
package WebApp;
use base 'CGI::Application';
# ( setup() can even be skipped for common cases. See docs below. )
sub setup {
my $self = shift;
$self->start_mode('mode1');
$self->mode_param('rm');
$self->run_modes(
'mode1' => 'do_stuff',
'mode2' => 'do_more_stuff',
'mode3' => 'do_something_else'
);
}
sub do_stuff { ... }
sub do_more_stuff { ... }
sub do_something_else { ... }
1;
### In "webapp.cgi"...
use WebApp;
my $webapp = WebApp->new();
$webapp->run();
### Or, in a PSGI file, webapp.psgi
use WebApp;
WebApp->psgi_app();
=head1 INTRODUCTION
CGI::Application makes it easier to create sophisticated, high-performance,
reusable web-based applications. CGI::Application helps makes your web
applications easier to design, write, and evolve.
CGI::Application judiciously avoids employing technologies and techniques which
would bind a developer to any one set of tools, operating system or web server.
It is lightweight in terms of memory usage, making it suitable for common CGI
environments, and a high performance choice in persistent environments like
FastCGI or mod_perl.
By adding L as your needs grow, you can add advanced and complex
features when you need them.
First released in 2000 and used and expanded by a number of professional
website developers, CGI::Application is a stable, reliable choice.
=head1 USAGE EXAMPLE
Imagine you have to write an application to search through a database
of widgets. Your application has three screens:
1. Search form
2. List of results
3. Detail of a single record
To write this application using CGI::Application you will create two files:
1. WidgetView.pm -- Your "Application Module"
2. widgetview.cgi -- Your "Instance Script"
The Application Module contains all the code specific to your
application functionality, and it exists outside of your web server's
document root, somewhere in the Perl library search path.
The Instance Script is what is actually called by your web server. It is
a very small, simple file which simply creates an instance of your
application and calls an inherited method, run(). Following is the
entirety of "widgetview.cgi":
#!/usr/bin/perl -w
use WidgetView;
my $webapp = WidgetView->new();
$webapp->run();
As you can see, widgetview.cgi simply "uses" your Application module
(which implements a Perl package called "WidgetView"). Your Application Module,
"WidgetView.pm", is somewhat more lengthy:
package WidgetView;
use base 'CGI::Application';
use strict;
# Needed for our database connection
use CGI::Application::Plugin::DBH;
sub setup {
my $self = shift;
$self->start_mode('mode1');
$self->run_modes(
'mode1' => 'showform',
'mode2' => 'showlist',
'mode3' => 'showdetail'
);
# Connect to DBI database, with the same args as DBI->connect();
$self->dbh_config();
}
sub teardown {
my $self = shift;
# Disconnect when we're done, (Although DBI usually does this automatically)
$self->dbh->disconnect();
}
sub showform {
my $self = shift;
# Get CGI query object
my $q = $self->query();
my $output = '';
$output .= $q->start_html(-title => 'Widget Search Form');
$output .= $q->start_form();
$output .= $q->textfield(-name => 'widgetcode');
$output .= $q->hidden(-name => 'rm', -value => 'mode2');
$output .= $q->submit();
$output .= $q->end_form();
$output .= $q->end_html();
return $output;
}
sub showlist {
my $self = shift;
# Get our database connection
my $dbh = $self->dbh();
# Get CGI query object
my $q = $self->query();
my $widgetcode = $q->param("widgetcode");
my $output = '';
$output .= $q->start_html(-title => 'List of Matching Widgets');
## Do a bunch of stuff to select "widgets" from a DBI-connected
## database which match the user-supplied value of "widgetcode"
## which has been supplied from the previous HTML form via a
## CGI.pm query object.
##
## Each row will contain a link to a "Widget Detail" which
## provides an anchor tag, as follows:
##
## "widgetview.cgi?rm=mode3&widgetid=XXX"
##
## ...Where "XXX" is a unique value referencing the ID of
## the particular "widget" upon which the user has clicked.
$output .= $q->end_html();
return $output;
}
sub showdetail {
my $self = shift;
# Get our database connection
my $dbh = $self->dbh();
# Get CGI query object
my $q = $self->query();
my $widgetid = $q->param("widgetid");
my $output = '';
$output .= $q->start_html(-title => 'Widget Detail');
## Do a bunch of things to select all the properties of
## the particular "widget" upon which the user has
## clicked. The key id value of this widget is provided
## via the "widgetid" property, accessed via the CGI.pm
## query object.
$output .= $q->end_html();
return $output;
}
1; # Perl requires this at the end of all modules
CGI::Application takes care of implementing the new() and the run()
methods. Notice that at no point do you call print() to send any
output to STDOUT. Instead, all output is returned as a scalar.
CGI::Application's most significant contribution is in managing
the application state. Notice that all which is needed to push
the application forward is to set the value of a HTML form
parameter 'rm' to the value of the "run mode" you wish to handle
the form submission. This is the key to CGI::Application.
=head1 ABSTRACT
The guiding philosophy behind CGI::Application is that a web-based
application can be organized into a specific set of "Run Modes."
Each Run Mode is roughly analogous to a single screen (a form, some
output, etc.). All the Run Modes are managed by a single "Application
Module" which is a Perl module. In your web server's document space
there is an "Instance Script" which is called by the web server as a
CGI (or an Apache::Registry script if you're using Apache + mod_perl).
This methodology is an inversion of the "Embedded" philosophy (ASP, JSP,
EmbPerl, Mason, etc.) in which there are "pages" for each state of the
application, and the page drives functionality. In CGI::Application,
form follows function -- the Application Module drives pages, and the
code for a single application is in one place; not spread out over
multiple "pages". If you feel that Embedded architectures are
confusing, unorganized, difficult to design and difficult to manage,
CGI::Application is the methodology for you!
Apache is NOT a requirement for CGI::Application. Web applications based on
CGI::Application will run equally well on NT/IIS or any other
CGI-compatible environment. CGI::Application-based projects
are, however, ripe for use on Apache/mod_perl servers, as they
naturally encourage Good Programming Practices and will often work
in persistent environments without modification.
For more information on using CGI::Application with mod_perl, please see our
website at http://www.cgi-app.org/, as well as
L, which integrates with L.
=head1 DESCRIPTION
It is intended that your Application Module will be implemented as a sub-class
of CGI::Application. This is done simply as follows:
package My::App;
use base 'CGI::Application';
B
For the purpose of this document, we will refer to the
following conventions:
WebApp.pm The Perl module which implements your Application Module class.
WebApp Your Application Module class; a sub-class of CGI::Application.
webapp.cgi The Instance Script which implements your Application Module.
$webapp An instance (object) of your Application Module class.
$c Same as $webapp, used in instance methods to pass around the
current object. (Sometimes referred as "$self" in other code)
=head2 Instance Script Methods
By inheriting from CGI::Application you have access to a
number of built-in methods. The following are those which
are expected to be called from your Instance Script.
=head3 new()
The new() method is the constructor for a CGI::Application. It returns
a blessed reference to your Application Module package (class). Optionally,
new() may take a set of parameters as key => value pairs:
my $webapp = WebApp->new(
TMPL_PATH => 'App/',
PARAMS => {
'custom_thing_1' => 'some val',
'another_custom_thing' => [qw/123 456/]
}
);
This method may take some specific parameters:
B - This optional parameter defines a path to a directory of templates.
This is used by the load_tmpl() method (specified below), and may also be used
for the same purpose by other template plugins. This run-time parameter allows
you to further encapsulate instantiating templates, providing potential for
more re-usability. It can be either a scalar or an array reference of multiple
paths.
B - This optional parameter allows you to specify an
already-created CGI.pm query object. Under normal use,
CGI::Application will instantiate its own CGI.pm query object.
Under certain conditions, it might be useful to be able to use
one which has already been created.
B - This parameter, if used, allows you to set a number
of custom parameters at run-time. By passing in different
values in different instance scripts which use the same application
module you can achieve a higher level of re-usability. For instance,
imagine an application module, "Mailform.pm". The application takes
the contents of a HTML form and emails it to a specified recipient.
You could have multiple instance scripts throughout your site which
all use this "Mailform.pm" module, but which set different recipients
or different forms.
One common use of instance scripts is to provide a path to a config file. This
design allows you to define project wide configuration objects used by many
several instance scripts. There are several plugins which simplify the syntax
for this and provide lazy loading. Here's an example using
L, which uses L to support
many configuration file formats.
my $app = WebApp->new(PARAMS => { cfg_file => 'config.pl' });
# Later in your app:
my %cfg = $self->cfg()
# or ... $self->cfg('HTML_ROOT_DIR');
See the list of plugins below for more config file integration solutions.
=head3 run()
The run() method is called upon your Application Module object, from
your Instance Script. When called, it executes the functionality
in your Application Module.
my $webapp = WebApp->new();
$webapp->run();
This method first determines the application state by looking at the
value of the CGI parameter specified by mode_param() (defaults to
'rm' for "Run Mode"), which is expected to contain the name of the mode of
operation. If not specified, the state defaults to the value
of start_mode().
Once the mode has been determined, run() looks at the dispatch
table stored in run_modes() and finds the function pointer which
is keyed from the mode name. If found, the function is called and the
data returned is print()'ed to STDOUT and to the browser. If
the specified mode is not found in the run_modes() table, run() will
croak().
=head2 PSGI support
CGI::Application offers native L support. The default query object
for this is L, which simply wrappers CGI.pm to provide PSGI
support to it.
=head3 psgi_app()
$psgi_coderef = WebApp->psgi_app({ ... args to new() ... });
The simplest way to create and return a PSGI-compatible coderef. Pass in
arguments to a hashref just as would to new. This returns a PSGI-compatible
coderef, using L as the query object. To use a different query
object, construct your own object using C<< run_as_psgi() >>, as shown below.
It's possible that we'll change from CGI::PSGI to a different-but-compatible
query object for PSGI support in the future, perhaps if CGI.pm adds native
PSGI support.
=head3 run_as_psgi()
my $psgi_aref = $webapp->run_as_psgi;
Just like C<< run >>, but prints no output and returns the data structure
required by the L specification. Use this if you want to run the
application on top of a PSGI-compatible handler, such as L provides.
If you are just getting started, just use C<< run() >>. It's easy to switch to using
C<< run_as_psgi >> later.
Why use C<< run_as_psgi() >>? There are already solutions to run
CGI::Application-based projects on several web servers with dozens of plugins.
Running as a PSGI-compatible application provides the ability to run on
additional PSGI-compatible servers, as well as providing access to all of the
"Middleware" solutions available through the L project.
The structure returned is an arrayref, containing the status code, an arrayref
of header key/values and an arrayref containing the body.
[ 200, [ 'Content-Type' => 'text/html' ], [ $body ] ]
By default the body is a single scalar, but plugins may modify this to return
other value PSGI values. See L for details about the
response format.
Note that calling C<< run_as_psgi >> only handles the I
We have received your form, and
we will get back to you shortly.
NOTE: It is not necessary that your HTML file be called 'thankyou.html'. You may name
this file anything you like. The only naming limitation is that the name of this
file should be correctly referenced in your 'mailform.cgi', in the variable 'SUCCESS_REDIRECT_URL'.
=head2 Create 'mailform.cgi'
The file 'mailform.cgi' is where all the functionality of CGI::Application::Mailform
is configured. This file is referred to as a "CGI instance script" because it
creates an "instance" of your form. A single website may have as many instance
scripts as needed. All of these instance scripts may use CGI::Application::Mailform.
They may each use a different form (with different fields, etc.) if desired.
The ability to create multiple instances of a single
application, each with a different configuration is one of the benefits
of building web-based applications using the CGI::Application framework.
Your instance script, 'mailform.cgi', must be created in such a way that it is
treated by your web server as an executable CGI application (as opposed to a
document). Generally (on UNIX), this entails setting the "execute bit" on the file and
configuring your web server to treat files ending ".cgi" as CGI applications.
Please refer to your particular web server's manual for configuration details.
Your instance script 'mailform.cgi' must start with the following:
#!/usr/bin/perl -w
use CGI::Application::Mailform;
my $mf = CGI::Application::Mailform->new();
These lines invoke the Perl interpreter, include the CGI::Application::Mailform
module, and instantiate a Mailform object, respectively. (The
author assumes your Perl binary is located at "/usr/bin/perl". If it is not,
change the first line to refer to the correct location of your Perl binary.)
Once you have a Mailform object ($mf), you have to configure the Mailform for your
particular application. This is done by using the param() method to set a number of
variables. These variables are specified as follows.
B
=over 4
=item MAIL_FROM
$mf->param('MAIL_FROM' => 'webmaster@your.domain');
This variable specifies the email address from which the email created by this
mailform will appear to be sent. This can be any address you like.
Typically, this will be "webmaster@your.domain". Keep in mind, this is
the address to which a bounce or a reply will be sent if one is generated
as a result of the mailform email. The MAIL_FROM can also be useful for
assisting the recipient of these email messages in automatically filtering
and organizing the submissions they receive.
This variable is required. If not specified, CGI::Application::Mailform
will die() with appropriate errors.
=item MAIL_TO
$mf->param('MAIL_TO' => 'form_recipient@your.domain');
This variable specifies the email address to which the email created by this
mailform should be sent. This should be the email address of the person to
whom the form contents should be emailed. This person will receive a
reasonably formatted message every time this mailform is submitted.
This variable is required. If not specified, CGI::Application::Mailform
will die() with appropriate errors.
=item HTMLFORM_REDIRECT_URL
$mf->param('HTMLFORM_REDIRECT_URL' => '/uri/or/url/to/mailform.html');
This variable specifies the URL (or URI) to which the web user should be
redirected before they have submitted the mailform. This should be the
HTML form which the user fills out, the contents of which will be
emailed once they are submitted.
This variable is required. If not specified, CGI::Application::Mailform
will die() with appropriate errors.
=item SUCCESS_REDIRECT_URL
$mf->param('SUCCESS_REDIRECT_URL' => '/uri/or/url/to/thankyou.html');
This variable specifies the URL (or URI) to which the web user should be
redirected once they have submitted the mailform. Typically, this would be
a "thank you" screen which assures the user that their form submission has
been received and processed.
This variable is required. If not specified, CGI::Application::Mailform
will die() with appropriate errors.
=item FORM_FIELDS
$mf->param('FORM_FIELDS' => [qw/name address comments etc/]);
This variable specifies the list of HTML form fields which will be
processed and sent via email to the specified recipient. Only the
form fields specified in this list will be put in the email message
which is generated by this mailform and sent to the specified
recipient.
The value of this variable must be an array reference.
This variable is required. If not specified, CGI::Application::Mailform
will die() with appropriate errors.
=back
B
=over 4
=item SMTP_HOST
$mf->param('SMTP_HOST' => 'mail.your.domain');
This variable specifies the Internet host name (or IP address) of the
server which provides Simple Mail Transfer Protocol (SMTP) services.
CGI::Application::Mailform sends all mail via SMTP using Net::SMTP.
If SMTP_HOST is unspecified, Net::SMTP will use the default host
which was specified when Net::SMTP was installed. If
CGI::Application::Mailform is unable to make an SMTP connection,
or successfully send mail via the SMTP host, it will die() with
appropriate errors.
=item SUBJECT
$mf->param('SUBJECT' => 'New form submission');
This variable specifies the subject line of the email message which is
created by this mailform. The subject is useful to the mailform recipient
in easily recognizing (and possibly filtering) form submissions.
This variable is optional. If not supplied, CGI::Application::Mailform will
set the subject to a reasonable default.
=item ENV_FIELDS
$mf->param('ENV_FIELDS' => [qw/REMOTE_ADDR HTTP_USER_AGENT/]);
This variable specifies the list of "environment" variables which will be
processed and sent via email to the specified recipient. Only the
environment variables specified in this list will be put in the email message
which is generated by this mailform and sent to the specified
recipient.
Any environment variable which is present in the CGI
environment may be included. Typical variables might be:
AUTH_TYPE
CONTENT_LENGTH
CONTENT_TYPE
GATEWAY_INTERFACE
HTTP_ACCEPT
HTTP_USER_AGENT
PATH_INFO
PATH_TRANSLATED
QUERY_STRING
REMOTE_ADDR
REMOTE_HOST
REMOTE_IDENT
REMOTE_USER
REQUEST_METHOD
SCRIPT_NAME
SERVER_NAME
SERVER_PORT
SERVER_PROTOCOL
SERVER_SOFTWARE
See your web server documentation for a complete list and descriptions
of the available environment variables. The list of environment variables
specified by the CGI protocol can be found at the following URL:
http://hoohoo.ncsa.uiuc.edu/cgi/env.html
The value of this variable must be an array reference. This variable
is optional. If not specified, no environment variables will be included
in the mailform email message.
=back
Finally, you must actually cause your Mailform to be executed by calling the run()
method. Your instance script 'mailform.cgi' should end with the following lines:
$mf->run();
exit(0);
These lines cause your configured Mailform ($mf) to be executed, and for the program to
cleanly exit, respectively.
NOTE: It is not necessary that your HTML file be called 'mailform.cgi'. You may name
this file anything you like. The only naming limitations are that this file should be
named so that your web server recognizes it as an executable CGI, and that your
'mailform.html' file specifies your instance script in the "action" attribute of the
element.
All things considered, your CGI instance script will be a very small, simple file. Unlike
other reusable "mailform" scripts, the instance scripts are specifically intended to be
very easy to work with. Essentially, these instance scripts are "configuration files" for
your web-based application. The structure of instance scripts is a benefit of
building applications based on the CGI::Application framework.
=head1 SEE ALSO
L
=head1 AUTHOR
Jesse Erlbaum
=head1 LICENSE
Copyright (c) 2001, 2002, Jesse Erlbaum .
This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
=cut
1;
CGI-Application-4.61/t 000755 001750 001750 0 13246212655 14207 5 ustar 00marto marto 000000 000000 CGI-Application-4.61/t/arrayrefmodes.t 000444 001750 001750 1704 13246212655 17376 0 ustar 00marto marto 000000 000000 use Test::More tests => 7;
use CGI;
# Include the test hierarchy
use lib 't/lib';
# Can we even use this module?
use_ok('TestApp8');
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
# Test array-ref mode
{
my $ta_obj = TestApp8->new();
my $output = $ta_obj->run();
# Did the run mode work?
like($output, qr/^Content\-Type\:\ text\/html/);
like($output, qr/Hello\ World\:\ testcgi1\_mode\ OK/);
}
{
my $q = CGI->new({rm=>testcgi2_mode});
my $ta_obj = TestApp8->new(QUERY=>$q);
my $output = $ta_obj->run();
# Did the run mode work?
like($output, qr/^Content\-Type\:\ text\/html/);
like($output, qr/Hello\ World\:\ testcgi2\_mode\ OK/);
}
{
my $q = CGI->new({rm=>testcgi3_mode});
my $ta_obj = TestApp8->new(QUERY=>$q);
my $output = $ta_obj->run();
# Did the run mode work?
like($output, qr/^Content\-Type\:\ text\/html/);
like($output, qr/Hello\ World\:\ testcgi3\_mode\ OK/);
}
###############
#### EOF ####
###############
CGI-Application-4.61/t/basic.t 000444 001750 001750 32516 13246212655 15641 0 ustar 00marto marto 000000 000000 use strict;
use Test::More tests => 112;
BEGIN{use_ok('CGI::Application');}
# Need CGI.pm for tests
use CGI;
# bring in testing hierarchy
use lib 't/lib';
use TestApp;
use TestApp2;
use TestApp3;
use TestApp4;
use TestApp5;
$ENV{CGI_APP_RETURN_ONLY} = 1;
sub response_like {
my ($app, $header_re, $body_re, $comment) = @_;
local $ENV{CGI_APP_RETURN_ONLY} = 1;
my $output = $app->run;
my ($header, $body) = split /\r\n\r\n/m, $output;
like($header, $header_re, "$comment (header match)");
like($body, $body_re, "$comment (body match)");
}
# Instantiate CGI::Application
# run() CGI::Application object.
# Expect header + output no_runmodes()
{
my $app = CGI::Application->new();
isa_ok($app, 'CGI::Application');
$app->query(CGI->new(""));
my $output = $app->run();
response_like(
$app,
qr{^Content-Type: text/html},
qr/Error - No runmodes specified./,
'base class response',
);
}
# Instantiate CGI::Application
# run() CGI::Application sub-class.
# Expect header + output dump_html()
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'dump_htm'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Query Environment:/,
'dump_html class response'
);
}
# Instantiate CGI::Application sub-class.
# run() CGI::Application sub-class.
# Expect HTTP header + 'Hello World: basic_test'.
{
my $app = TestApp->new(QUERY => CGI->new(""));
isa_ok($app, 'CGI::Application');
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: basic_test/,
'TestApp, blank query',
);
}
# Non-hash references are invalid for PARAMS.
{
my $app = eval { TestApp->new(PARAMS => [ 1, 2, 3, ]); };
like($@, qr/not a hash ref/, "PARAMS must be a hashref!");
}
# run() CGI::Application sub-class, in run mode 'redirect_test'.
# Expect HTTP redirect header + 'Hello World: redirect_test'.
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'redirect_test'}));
response_like(
$app,
qr/^Status: 302/,
qr/Hello World: redirect_test/,
'TestApp, redirect_test'
);
}
# run() CGI::Application sub-class, in run mode 'redirect_test'.
# Expect HTTP redirect header + 'Hello World: redirect_test'.
# ...just like the test above, but we pass QUERY in via a hashref.
{
my $app = TestApp->new({
QUERY => CGI->new({'test_rm' => 'redirect_test'})
});
response_like(
$app,
qr/^Status: 302/,
qr/Hello World: redirect_test/,
'TestApp, redirect_test'
);
}
# run() CGI::Application sub-class, in run mode 'dump_text'.
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'dump_txt'}));
response_like(
$app,
qr{^Content-type: text/html}i,
qr/Query Environment/,
'TestApp, dump_text'
);
}
# run() CGI::Application sub-class, in run mode 'cookie_test'.
# Expect HTTP header w/ cookie:
# 'c_name' => 'c_value' + 'Hello World: cookie_test'.
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'cookie_test'}));
response_like(
$app,
qr/^Set-Cookie: c_name=c_value/,
qr/Hello World: cookie_test/,
"TestApp, cookie test",
);
}
# run() CGI::Application sub-class, in run mode 'tmpl_test'.
# Expect HTTP header + 'Hello World: tmpl_test'.
{
my $app = TestApp->new(TMPL_PATH=>'t/lib/templates/');
$app->query(CGI->new({'test_rm' => 'tmpl_test'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/---->Hello World: tmpl_test<----/,
"TestApp, tmpl_test",
);
}
# run() CGI::Application sub-class, in run mode 'tmpl_badparam_test'.
# Expect HTTP header + 'Hello World: tmpl_badparam_test'.
{
my $app = TestApp->new(TMPL_PATH=>'t/lib/templates/');
$app->query(CGI->new({'test_rm' => 'tmpl_badparam_test'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/---->Hello World: tmpl_badparam_test<----/,
"TestApp, tmpl_badparam_test",
);
}
# Instantiate and call run_mode 'eval_test'. Expect 'eval_test OK' in output.
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'eval_test'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: eval_test OK/,
"TestApp, eval_test",
);
}
# Test to make sure cgiapp_init() was called in inherited class.
{
my $app = TestApp2->new();
my $init_state = $app->param('CGIAPP_INIT');
ok(defined($init_state), "TestApp2's cgiapp_init ran");
is($init_state, 'true', "TestApp2's cgiapp_init set the right value");
}
# Test to make sure mode_param() can contain subref
{
my $app = TestApp3->new();
$app->query(CGI->new({'go_to_mode' => 'subref_modeparam'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: subref_modeparam OK/,
"TestApp3, subref_modeparam",
);
}
# Test to make sure that "false" (but >0 length) run modes are valid -- will
# not default to start_mode()
{
my $app = TestApp3->new();
$app->query(CGI->new({'go_to_mode' => '0'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: zero_mode OK/,
"TestApp3, 0 as run mode isn't start_mode",
);
}
# A blank mode_param value isn't useful; we fall back to start_mode.
{
my $app = TestApp3->new();
$app->query(CGI->new({'go_to_mode' => ''}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: default_mode OK/,
"TestApp3, q() as run mode is start_mode",
);
}
# Test to make sure that undef run modes will default to start_mode()
{
my $app = TestApp3->new();
$app->query(CGI->new({'go_to_mode' => 'undef_rm'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: default_mode OK/,
"TestApp3, undef run mode (goes to start_mode)",
);
}
# Test run modes returning scalar-refs instead of scalars
{
my $app = TestApp4->new(QUERY=>CGI->new(""));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: subref_test OK/,
"run modes can return scalar references",
);
}
# Test "AUTOLOAD" run mode
{
my $app = TestApp4->new();
$app->query(CGI->new({'rm' => 'undefined_mode'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: undefined_mode OK/,
"AUTOLOAD run mode",
);
}
# what if there is no AUTOLOAD?
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'undefined_mode'}));
my $output = eval { $app->run };
like($@, qr/No such run mode/, "no runmode + no autoload = exception");
}
# Can we incrementally add run modes?
# XXX: I don't see how this code tests that question. -- rjbs, 2006-06-30
{
my $app;
my $output;
# Mode: BasicTest
$app = TestApp5->new();
$app->query(CGI->new({'rm' => 'basic_test1'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: basic_test1/,
"force basic_test1",
);
# Mode: BasicTest2
$app = TestApp5->new();
$app->query(CGI->new({'rm' => 'basic_test2'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: basic_test2/,
"force basic_test2",
);
# Mode: BasicTest3
$app = TestApp5->new();
$app->query(CGI->new({'rm' => 'basic_test3'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/Hello World: basic_test3/,
"force basic_test3",
);
}
# Can we add params in batches?
{
my $app = TestApp5->new(
PARAMS => {
P1 => 'one',
P2 => 'two'
}
);
# Do params set via new still get set?
my @plist = sort $app->param();
is_deeply(\@plist, ['P1', 'P2'], "Pn params set during initialization");
my @params = (
'', 'one', 'two', 'new three', 'four', 'new five', 'six', 'seven', 'eight'
);
is($app->param("P$_"), $params[$_], "P$_ of 2 correct") for 1..2;
# Can we still augment params one at a time?
$app->param('P3', 'three');
@plist = sort $app->param();
is_deeply(\@plist, ['P1', 'P2', 'P3'], 'added one param to list');
is($app->param("P$_"), $params[$_], "P$_ of 2 correct again") for 1..2;
is($app->param("P3"), 'three', "and new arg, P3, is also correct");
# Does a list of pairs work?
my $pt3val = $app->param(
'P3' => 'new three',
'P4' => 'four',
'P5' => 'five'
);
@plist = sort $app->param();
is_deeply(\@plist, ['P1', 'P2', 'P3', 'P4', 'P5'], "all five args set ok");
is($app->param("P$_"), $params[$_], "P$_ of 4 correct") for 1..4;
is($app->param("P5"), 'five', "P5 also correct");
# XXX: Do we really want to test for this? Maybe we want to change this
# behavior, on which hopefully nothing but this test depends...
# -- rjbs, 2006-06-30
ok(not(defined($pt3val)), "multiple param setting returns undef (for now)");
# What about a hash-ref? (Should return undef)
my $pt4val = $app->param({
'P5' => 'new five',
'P6' => 'six',
'P7' => 'seven',
});
@plist = sort $app->param();
is_deeply(\@plist, ['P1', 'P2', 'P3', 'P4', 'P5', 'P6', 'P7'], "7 params ok");
is($app->param("P$_"), $params[$_], "P$_ of 7 correct") for 1..7;
ok(not(defined($pt4val)), "multiple param setting returns undef (for now)");
# What about a simple pass-through? (Should return param value)
my $pt5val = $app->param('P8', 'eight');
@plist = sort $app->param();
is_deeply(\@plist, [qw(P1 P2 P3 P4 P5 P6 P7 P8)], "P1-8 all ok");
is($app->param("P$_"), $params[$_], "P$_ of 8 correct") for 1..8;
is($pt5val, 'eight', "value returned on setting P8 is correct");
}
# test undef param values
{
my $app = TestApp->new();
$app->param(foo => 10);
is(
$app->delete,
undef,
"we get undef when deleting unnamed param",
);
is($app->param('foo'), 10, q(and our real param is still ok));
}
# test setting header_props before header_type
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'props_before_redirect_test'}));
my $output = $app->run();
like($output, qr/test: 1/i, "added test header before redirect");
like($output, qr/Status: 302/, "and still redirected");
}
# testing setting header_props more than once
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'header_props_twice_nomerge'}));
my $output = $app->run();
like($output, qr/test: Updated/i, "added test header");
unlike($output, qr/second-header: 1/, "no second-header header");
unlike($output, qr/Test2:/, "no Test2 header, either");
}
# testing header_add with arrayref
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'header_add_arrayref_test'}));
my $output = $app->run();
like($output, qr/Set-Cookie: cookie1=header_add/, "arrayref test: cookie1");
like($output, qr/Set-Cookie: cookie2=header_add/, "arrayref test: cookie2");
}
# make sure header_add does not clobber earlier headers
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'header_props_before_header_add'}));
my $output = $app->run();
like($output, qr/Set-Cookie: cookie1=header_props/, "header_props: cookie1");
like($output, qr/Set-Cookie: cookie2=header_add/, "header_add: cookie2");
}
# make sure header_add works after header_props is called
{
my $app = TestApp->new();
$app->query(CGI->new({'test_rm' => 'header_add_after_header_props'}));
my $output = $app->run();
like($output, qr/Set-Cookie: cookie2=header_add/, "header add after props");
}
# test use of TMPL_PATH without trailing slash
{
my $app = TestApp->new(TMPL_PATH=>'t/lib/templates');
$app->query(CGI->new({'test_rm' => 'tmpl_badparam_test'}));
response_like(
$app,
qr{^Content-Type: text/html},
qr/---->Hello World: tmpl_badparam_test<----/,
"TMPL_PATH without trailing slash",
);
}
# If called "too early" we get undef for current runmode.
{
my $app = CGI::Application->new;
eval { $app->run_modes('whatever') };
like($@, qr/odd number/i, "croak on odd number of args to run_modes");
}
# If called "too early" we get undef for current runmode.
{
my $app = CGI::Application->new;
is($app->get_current_runmode, undef, "current runmode is undef before run");
my $dump = $app->dump;
like($dump, qr/^Current Run mode: ''\n/, "no current run mode in dump");
}
# test delete() method by first setting some params and then deleting them
{
my $app = TestApp5->new();
$app->param(
P1 => 'one',
P2 => 'two',
P3 => 'three'
);
is_deeply(
[ sort $app->param ],
[ qw(P1 P2 P3) ],
"we start with P1 P2 P3",
);
#a valid delete
my $p2value = $app->delete('P2');
my @params = sort $app->param();
is_deeply(\@params, ['P1', 'P3'], "P2 deletes without incident");
is($p2value, "two", "and deletion returns the deleted value");
is($app->param('P1'), 'one', 'P1 still has the right value');
ok(!defined($app->param('P2')), 'P2 is now undef');
is_deeply(
[ sort $app->param ],
['P1', 'P3'],
"asking for P2 didn't instantiate it",
);
is($app->param('P3'), 'three', 'P3 still has the right value');
#an invalid delete
my $result = $app->delete('P4');
ok(!defined($result), "we get undef back when deleting nonexistant param");
is($app->param('P1'), 'one', "and P1's value is unmolested");
ok(!defined($app->param('P4')), "and the fake param doesn't get a value");
is($app->param('P3'), 'three', "and P3 is unmolested too");
}
###
my $t27_ta_obj = CGI::Application->new(
TMPL_PATH => [qw(t/lib/templates /some/other/test/path)]
);
my ($t1, $t2) = (0,0);
my $tmpl_path = $t27_ta_obj->tmpl_path();
ok((ref $tmpl_path eq 'ARRAY'), 'tmpl_path returns array ref');
is($tmpl_path->[0], 't/lib/templates', 'tmpl_path first element is correct');
is($tmpl_path->[1], '/some/other/test/path', 'tmpl_path second element is correct');
my $tmpl = $t27_ta_obj->load_tmpl('test.tmpl');
$tmpl_path = $tmpl->{options}->{path};
ok((ref $tmpl_path eq 'ARRAY'), 'tmpl_path from H::T obj returns array ref');
ok(($tmpl_path->[0] eq 't/lib/templates'), 'tmpl_path from H::T obj first element is correct');
ok(($tmpl_path->[1] eq '/some/other/test/path'), 'tmpl_path from H::T obj second element is correct');
# All done!
CGI-Application-4.61/t/callbacks.t 000444 001750 001750 37476 13246212654 16510 0 ustar 00marto marto 000000 000000
use strict;
use Test::More tests => 5;
# Record the subroutines we've seen in a session
my @Event_History;
sub main::record_event {
my ($hook_name) = @_;
my $sub = (caller 1)[3];
push @Event_History, "$hook_name/$sub";
}
BEGIN { use_ok('CGI::Application') };
######################################
{
package CGI::Application::Plugin::Foo;
use vars qw/@EXPORT @ISA/;
@ISA = ('Exporter');
@EXPORT = qw(
foo_custom
foo_init1
foo_init2
foo_prerun
foo_postrun
foo_teardown
);
sub import {
my $caller = caller;
$caller->new_hook('foo_hook');
# Foo's hooks are added by reference. They cannot be overridden by the
# application
$caller->add_callback('foo_hook', \&foo_custom);
$caller->add_callback('init', \&foo_init1);
$caller->add_callback('init', \&foo_init2);
$caller->add_callback('prerun', \&foo_prerun);
$caller->add_callback('postrun', \&foo_postrun);
$caller->add_callback('teardown', \&foo_teardown);
goto &Exporter::import;
}
sub foo_custom { main::record_event('foo_hook') }
sub foo_init1 { main::record_event('init') }
sub foo_init2 { main::record_event('init') }
sub foo_prerun { main::record_event('prerun') }
sub foo_postrun { main::record_event('postrun') }
sub foo_teardown {
my $self = shift;
main::record_event('teardown');
$self->call_hook('foo_hook');
}
}
######################################
{
package CGI::Application::Plugin::Bar;
use vars qw/@EXPORT @ISA/;
@ISA = ('Exporter');
@EXPORT = qw(
bar_custom
bar_init1
bar_init2
bar_prerun
bar_postrun
bar_teardown
);
sub import {
my $caller = caller;
$caller->new_hook('bar_hook');
$caller->add_callback('bar_hook', 'bar_custom');
$caller->add_callback('init', 'bar_init1');
$caller->add_callback('init', 'bar_init2');
$caller->add_callback('prerun', 'bar_prerun');
$caller->add_callback('postrun', 'bar_postrun');
$caller->add_callback('teardown', 'bar_teardown');
goto &Exporter::import;
}
sub bar_custom { main::record_event('bar_hook') }
sub bar_init1 {
my $self = shift;
main::record_event('init');
$self->call_hook('bar_hook');
}
sub bar_init2 { main::record_event('init') }
sub bar_prerun { main::record_event('prerun') }
sub bar_postrun { main::record_event('postrun') }
sub bar_teardown { main::record_event('teardown') }
}
######################################
{
package CGI::Application::Plugin::Baz;
use vars qw/@EXPORT @ISA/;
@ISA = ('Exporter');
@EXPORT = qw(
baz_custom
baz_init1
baz_init2
baz_prerun
baz_postrun
baz_teardown
);
sub import {
my $caller = caller;
$caller->new_hook('baz_hook');
$caller->add_callback('baz_hook', 'baz_custom');
$caller->add_callback('init', 'baz_init1');
$caller->add_callback('init', 'baz_init2');
$caller->add_callback('prerun', 'baz_prerun');
$caller->add_callback('postrun', 'baz_postrun');
$caller->add_callback('teardown', 'baz_teardown');
goto &Exporter::import;
}
sub baz_custom { main::record_event('baz_hook') }
sub baz_init1 { main::record_event('init') }
sub baz_init2 { main::record_event('init') }
sub baz_prerun {
my $self = shift;
main::record_event('prerun');
$self->call_hook('baz_hook');
}
sub baz_postrun { main::record_event('postrun') }
sub baz_teardown { main::record_event('teardown') }
}
######################################
{
package CGI::Application::Plugin::Bam;
use vars qw/@EXPORT @ISA/;
@ISA = ('Exporter');
@EXPORT = qw(
bam_custom
bam_init1
bam_init2
bam_prerun
bam_postrun
bam_teardown
);
sub import {
my $caller = caller;
$caller->new_hook('bam_hook');
$caller->add_callback('bam_hook', 'bam_custom');
$caller->add_callback('init', 'bam_init1');
$caller->add_callback('init', 'bam_init2');
$caller->add_callback('prerun', 'bam_prerun');
$caller->add_callback('postrun', 'bam_postrun');
$caller->add_callback('teardown', 'bam_teardown');
goto &Exporter::import;
}
sub bam_custom { main::record_event('bam_hook') }
sub bam_init1 { main::record_event('init') }
sub bam_init2 { main::record_event('init') }
sub bam_prerun { main::record_event('prerun') }
sub bam_postrun {
my $self = shift;
main::record_event('postrun');
$self->call_hook('bam_hook');
}
sub bam_teardown { main::record_event('teardown') }
}
######################################
{
package My::Framework;
use vars qw/@ISA/;
@ISA = ('CGI::Application');
sub cgiapp_init { main::record_event('init') }
sub cgiapp_prerun { main::record_event('prerun') }
sub cgiapp_postrun { main::record_event('postrun') }
sub teardown { main::record_event('teardown') }
}
######################################
{
package My::Project;
use vars qw/@ISA/;
@ISA = ('My::Framework');
import CGI::Application::Plugin::Foo;
# install another init callback for all users of My::Project
My::Project->add_callback('init', 'my_project_init');
# install an impolite callback that will get run by all CGI::Application apps
# regardless of whether or not they use My::Project
CGI::Application->add_callback('init', \&my_project_global_init);
sub my_project_init { main::record_event('init') }
sub my_project_global_init { main::record_event('init') }
}
######################################
{
package Other::Project;
use vars qw/@ISA/;
@ISA = ('My::Framework');
import CGI::Application::Plugin::Baz;
import CGI::Application::Plugin::Bam;
# install another init callback for all users of Other::Project
Other::Project->add_callback('init', 'other_project_init');
# install an impolite callback that will get run by all CGI::Application apps
# regardless of whether or not they use My::Project
CGI::Application->add_callback('init', \&other_project_global_init);
sub other_project_init { main::record_event('init') }
sub other_project_global_init { main::record_event('init') }
}
######################################
{
package My::App;
use vars qw/@ISA/;
@ISA = ('My::Project');
import CGI::Application::Plugin::Bar;
sub setup {
my $self = shift;
$self->header_type('none');
$self->run_modes(['begin']);
$self->start_mode('begin');
}
sub cgiapp_init {
my $self = shift;
main::record_event('init');
__PACKAGE__->add_callback('prerun', 'my_app_class_prerun');
__PACKAGE__->add_callback('teardown', 'my_app_teardown');
$self->add_callback('teardown', 'my_app_teardown');
}
sub cgiapp_prerun { main::record_event('prerun') }
sub my_app_class_prerun { main::record_event('prerun') }
sub my_app_obj_prerun { main::record_event('prerun') }
sub my_app_teardown { main::record_event('teardown') }
sub cgiapp_postrun { main::record_event('postrun') }
sub teardown { main::record_event('teardown') }
sub begin {
main::record_event('runmode');
return '';
}
}
######################################
{
package Other::App;
use vars qw/@ISA/;
@ISA = 'Other::Project';
import CGI::Application::Plugin::Bam;
sub setup {
my $self = shift;
$self->header_type('none');
$self->run_modes(['begin']);
$self->start_mode('begin');
}
sub cgiapp_init {
my $self = shift;
$self->add_callback('postrun', 'other_app_postrun');
main::record_event('init')
}
sub cgiapp_prerun { main::record_event('prerun') }
sub cgiapp_postrun { main::record_event('postrun') }
sub other_app_postrun { main::record_event('postrun') }
sub teardown { main::record_event('teardown') }
sub begin {
main::record_event('runmode');
return '';
}
}
{
package Unrelated::App;
use vars qw/@ISA/;
@ISA = ('CGI::Application');
sub setup {
my $self = shift;
$self->header_type('none');
$self->run_modes(['begin']);
$self->start_mode('begin');
}
sub cgiapp_init { main::record_event('init') }
sub cgiapp_prerun { main::record_event('prerun') }
sub cgiapp_postrun { main::record_event('postrun') }
sub teardown { main::record_event('teardown') }
sub begin {
main::record_event('runmode');
return '';
}
}
@Event_History = ();
my $app = My::App->new;
$app->add_callback('prerun', 'my_app_obj_prerun');
$app->run;
my @expected_events = (
# init
'init/CGI::Application::Plugin::Bar::bar_init1', # CAP::Bar
'bar_hook/CGI::Application::Plugin::Bar::bar_custom',
'init/CGI::Application::Plugin::Bar::bar_init2',
'init/CGI::Application::Plugin::Foo::foo_init1', # CAP::Foo
'init/CGI::Application::Plugin::Foo::foo_init2',
'init/My::Project::my_project_init', # My::Project
'init/My::App::cgiapp_init', # My::App (but installed via CGI::Application)
'init/My::Project::my_project_global_init', # My::Project (rudely) registered a callback in the
# CGI::Application class
'init/Other::Project::other_project_global_init', # Other::Project (rudely) registered a callback in the
# CGI::Application class, which forces us to run it
# prerun
'prerun/My::App::my_app_obj_prerun', # My::App (installed in object)
'prerun/CGI::Application::Plugin::Bar::bar_prerun', # CAP::Foo
'prerun/My::App::my_app_class_prerun', # My::App (but installed at runtime)
'prerun/CGI::Application::Plugin::Foo::foo_prerun', # CAP::Bar
'prerun/My::App::cgiapp_prerun', # My::App (but installed via CGI::Application)
# Run mode
'runmode/My::App::begin', # My::App
# postrun
'postrun/CGI::Application::Plugin::Bar::bar_postrun', # CAP::Bar
'postrun/CGI::Application::Plugin::Foo::foo_postrun', # CAP::Foo
'postrun/My::App::cgiapp_postrun', # My::App (but installed via CGI::Application)
# teardown
'teardown/My::App::my_app_teardown', # My::App (but installed in object)
'teardown/CGI::Application::Plugin::Bar::bar_teardown', # CAP::Bar
'teardown/CGI::Application::Plugin::Foo::foo_teardown', # CAP::Foo
'foo_hook/CGI::Application::Plugin::Foo::foo_custom', # CAP::Foo
'teardown/My::App::teardown', # My::App (but installed via CGI::Application)
);
is_deeply(\@Event_History, \@expected_events, 'My::App - callbacks executed correctly (first run)')
or do {
use Data::Dumper;
print STDERR "Actual Event History: \n";
print STDERR Dumper \@Event_History;
};
# Second run of My::App : the callback registered directly in self are
# no longer installed
@Event_History = ();
My::App->new->run;
@expected_events = (
# init
'init/CGI::Application::Plugin::Bar::bar_init1', # CAP::Bar
'bar_hook/CGI::Application::Plugin::Bar::bar_custom',
'init/CGI::Application::Plugin::Bar::bar_init2',
'init/CGI::Application::Plugin::Foo::foo_init1', # CAP::Foo
'init/CGI::Application::Plugin::Foo::foo_init2',
'init/My::Project::my_project_init', # My::Project
'init/My::App::cgiapp_init', # My::App (but installed via CGI::Application)
'init/My::Project::my_project_global_init', # My::Project (rudely) registered a callback in the
# CGI::Application class
'init/Other::Project::other_project_global_init', # Other::Project (rudely) registered a callback in the
# CGI::Application class, which forces us to run it
# prerun
'prerun/CGI::Application::Plugin::Bar::bar_prerun', # CAP::Foo
'prerun/My::App::my_app_class_prerun', # My::App (but installed at runtime)
'prerun/CGI::Application::Plugin::Foo::foo_prerun', # CAP::Bar
'prerun/My::App::cgiapp_prerun', # My::App (but installed via CGI::Application)
# Run mode
'runmode/My::App::begin', # My::App
# postrun
'postrun/CGI::Application::Plugin::Bar::bar_postrun', # CAP::Bar
'postrun/CGI::Application::Plugin::Foo::foo_postrun', # CAP::Foo
'postrun/My::App::cgiapp_postrun', # My::App (but installed via CGI::Application)
# teardown
'teardown/My::App::my_app_teardown', # My::App (but installed in object)
'teardown/CGI::Application::Plugin::Bar::bar_teardown', # CAP::Bar
'teardown/CGI::Application::Plugin::Foo::foo_teardown', # CAP::Foo
'foo_hook/CGI::Application::Plugin::Foo::foo_custom', # CAP::Foo
'teardown/My::App::teardown', # My::App (but installed via CGI::Application)
);
is_deeply(\@Event_History, \@expected_events, 'My::App - callbacks executed correctly (second run)')
or do {
use Data::Dumper;
print STDERR "Actual Event History: \n";
print STDERR Dumper \@Event_History;
};
@Event_History = ();
Other::App->new->run;
@expected_events = (
# init
'init/CGI::Application::Plugin::Bam::bam_init1', # CAP::Bam
'init/CGI::Application::Plugin::Bam::bam_init2',
'init/CGI::Application::Plugin::Baz::baz_init1', # CAP::Baz
'init/CGI::Application::Plugin::Baz::baz_init2',
'init/Other::Project::other_project_init', # Other::Project
'init/Other::App::cgiapp_init', # Other::App (but installed via CGI::Application)
'init/My::Project::my_project_global_init', # My::Project (rudely) registered a callback in the
# CGI::Application class, which forces us to run it
'init/Other::Project::other_project_global_init', # Other::Project (rudely) registered a callback in the
# CGI::Application class
# prerun
'prerun/CGI::Application::Plugin::Bam::bam_prerun', # CAP::Baz
'prerun/CGI::Application::Plugin::Baz::baz_prerun', # CAP::Bam
'baz_hook/CGI::Application::Plugin::Baz::baz_custom', # CAP::Bam
'prerun/Other::App::cgiapp_prerun', # Other::App (but installed via CGI::Application)
# Run mode
'runmode/Other::App::begin', # Other::App
# postrun
'postrun/Other::App::other_app_postrun', # Other::App (but installed in object)
'postrun/CGI::Application::Plugin::Bam::bam_postrun', # CAP::Bam
'bam_hook/CGI::Application::Plugin::Bam::bam_custom', # CAP::Bam
'postrun/CGI::Application::Plugin::Baz::baz_postrun', # CAP::Baz
'postrun/Other::App::cgiapp_postrun', # Other::App (but installed via CGI::Application)
# teardown
'teardown/CGI::Application::Plugin::Bam::bam_teardown', # CAP::Bam
'teardown/CGI::Application::Plugin::Baz::baz_teardown', # CAP::Baz
'teardown/Other::App::teardown', # Other::App (but installed via CGI::Application)
);
is_deeply(\@Event_History, \@expected_events, 'Other::App - callbacks executed correctly')
or do {
use Data::Dumper;
print STDERR "Actual Event History: \n";
print STDERR Dumper \@Event_History;
};
@Event_History = ();
Unrelated::App->new->run;
@expected_events = (
# init
'init/Unrelated::App::cgiapp_init', # Unrelated::App (but installed via CGI::Application)
'init/My::Project::my_project_global_init', # My::Project (rudely) registered a callback in the
# CGI::Application class, which forces us to run it
'init/Other::Project::other_project_global_init', # Unrelated::Project (rudely) registered a callback in the
# CGI::Application class, which forces us to run it
# prerun
'prerun/Unrelated::App::cgiapp_prerun', # Unrelated::App (but installed via CGI::Application)
# Run mode
'runmode/Unrelated::App::begin', # Unrelated::App
# postrun
'postrun/Unrelated::App::cgiapp_postrun', # Unrelated::App (but installed via CGI::Application)
# teardown
'teardown/Unrelated::App::teardown', # Unrelated::App (but installed via CGI::Application)
);
is_deeply(\@Event_History, \@expected_events, 'Unrelated::App - callbacks executed correctly')
or do {
use Data::Dumper;
print STDERR "Actual Event History: \n";
print STDERR Dumper \@Event_History;
};
CGI-Application-4.61/t/default_runmode.t 000444 001750 001750 1130 13246212654 17700 0 ustar 00marto marto 000000 000000 use strict;
use warnings;
use Test::More tests => 1;
$ENV{'CGI_APP_RETURN_ONLY'} = 1; # don't print
{
package WithStartIssue;
use base 'CGI::Application';
# register custom "start" run mode.
# this is what CAP::AutoRunmode and CAP::RunmodeDeclare do.
__PACKAGE__->add_callback('init' => sub {
shift->run_modes('start' => 'my_start');
}
);
sub my_start { return 'my start' }
# don't output a header
sub cgiapp_prerun {
shift->header_type('none');
}
}
my $issue = WithStartIssue->new;
my $out = $issue->run;
is $out, 'my start';
CGI-Application-4.61/t/enhancement31.t 000444 001750 001750 1211 13246212654 17154 0 ustar 00marto marto 000000 000000 use Test::More tests=>2;
# Include the test hierarchy
use lib 't/lib';
use CGI;
use TestCGI;
use TestApp9;
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
# Query object may be initialized via new()
# to a non-CGI.pm object type
{
my $cgi_obj = TestCGI->new();
my $testapp = TestApp9->new(QUERY=>$cgi_obj);
my $query_back = $testapp->query();
isa_ok($query_back, "TestCGI");
}
# $CGIApp->header_type('none') returns only content.
{
my $q = CGI->new({rm=>"noheader"});
my $app = TestApp9->new(QUERY=>$q);
my $output = $app->run();
unlike($output, qr/^Content\-Type\:\ text\/html/, "Headers 'none'");
}
CGI-Application-4.61/t/errormode.t 000444 001750 001750 1267 13246212655 16535 0 ustar 00marto marto 000000 000000 use Test::More tests=>6;
# Include the test hierarchy
use lib 't/lib';
BEGIN {
use_ok('TestApp11');
use_ok('TestApp12');
};
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
# Usage of error_mode will catch a runtime failure
{
my $app = TestApp11->new;
my $output = $app->run();
like($output, qr/Success!/, "Errormode works");
like($output, qr/mode1 failed/, 'Errormode received $@ as value');
}
# Need to see what happens when error_mode itself fails
{
my $app = TestApp12->new;
my $output;
eval {
$output = $app->run();
};
ok( defined $@, "Make sure the error_mode did fail" );
like($@, qr/Oops/, "Errormode fails correctly");
}
CGI-Application-4.61/t/getquery.t 000444 001750 001750 721 13246212655 16356 0 ustar 00marto marto 000000 000000 use Test::More tests => 3;
# Include the test hierarchy
use lib 't/lib';
# Can we even use this module?
use_ok('TestApp7');
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
# Test basic cgiapp_get_query()
{
my $ta_obj = TestApp7->new();
my $output = $ta_obj->run();
# Did the run mode work?
like($output, qr/^Content\-Type\:\ text\/html/);
like($output, qr/Hello\ World\:\ testcgi\_mode\ OK/);
}
###############
#### EOF ####
###############
CGI-Application-4.61/t/header_props.t 000444 001750 001750 3041 13246212654 17201 0 ustar 00marto marto 000000 000000
use strict;
use Test::More tests => 9;
BEGIN{use_ok('CGI::Application');}
$ENV{CGI_APP_RETURN_ONLY} = 1;
{
my $app = CGI::Application->new;
$app->header_type('none');
my $warn = '';
local $SIG{__WARN__} = sub {
$warn = shift;
};
$app->header_props(-type => 'banana/ripe');
like(
$warn,
qr/header_type set to 'none'/,
"warn if we set header while header type is none",
);
}
{
my $app = CGI::Application->new;
eval { $app->header_props(123); };
like(
$@,
qr/odd number/i,
"croak on odd number of non-ref args to header_props",
);
eval { $app->header_add(123); };
like(
$@,
qr/odd number/i,
"croak on odd number of non-ref args to header_add",
);
}
{
my $app = CGI::Application->new;
$app->header_props({ -type => 'banana/ripe' });
$app->header_add({ -expires => '1d' });
like(
$app->run,
qr{Content-type: banana/ripe}i,
"headed added via hashref arg to header_props",
);
like(
$app->run,
qr{^Expires: }im,
"headed added via hashref arg to header_add",
);
}
{
my $app = CGI::Application->new;
$app->header_props({ -type => 'banana/ripe' });
like(
$app->run,
qr{Content-type: banana/ripe}i,
"headed added via hashref arg to header_props",
);
$app->header_props();
like(
$app->run,
qr{Content-type: banana/ripe}i,
"Calling with no args is safe",
);
$app->header_props({});
unlike(
$app->run,
qr{Content-type: banana/ripe}i,
"Calling with an empty hashref clobbers existing data",
);
}
CGI-Application-4.61/t/load_tmpl_hook.t 000444 001750 001750 1744 13246212654 17531 0 ustar 00marto marto 000000 000000 #!/usr/bin/perl
use Test::More tests => 5;
use CGI::Application;
$ENV{CGI_APP_RETURN_ONLY} = 1;
my $app = CGI::Application->new();
my $out = $app->run;
like($out, qr/Error - No runmodes specified/, "normal app output contains start");
unlike($out, qr/load_tmpl_hook/, "normal app output doesn't contain load_tmpl_hook");
{
$app->add_callback('load_tmpl', sub {
my ($self,$ht_params,$tmpl_params,$tmpl_name) = @_;
$self->query->param('load_tmpl_hook' => 1);
$tmpl_params->{'ping'} = 'ping_hook';
$self->param('found_file_name',$tmpl_name);
});
my $t = $app->load_tmpl('t/lib/templates/test.tmpl', );
my $out = $app->run;
like($out, qr/load_tmpl_hook/, "adding load_tmpl callback causes load_tmpl_hook to appear");
like($t->output, qr/ping_hook/, 'load_tmpl callback affected template' );
is( $app->param('found_file_name'), 't/lib/templates/test.tmpl',
'template name passed into callback works');
}
CGI-Application-4.61/t/mailform.t 000444 001750 001750 753 13246212654 16323 0 ustar 00marto marto 000000 000000 use Test::More tests => 4;
SKIP: {
# Check for Net::SMTP
eval { require Net::SMTP; };
skip("Net::SMTP is not installed. CGI::Application::Mailform requires Net::SMTP.", 4)
if ($@);
# Can we even use this module?
require_ok('CGI::Application::Mailform');
my $mf = CGI::Application::Mailform->new();
# Is it a Mailform?
isa_ok($mf, 'CGI::Application::Mailform');
# If it a CGI-App?
isa_ok($mf, 'CGI::Application');
# Did it inherit the run method?
can_ok($mf, qw/run/);
}
CGI-Application-4.61/t/mode_param_overwritten.t 000444 001750 001750 571 13246212655 21270 0 ustar 00marto marto 000000 000000 # This is for a bug introduced in 4.02 where mode_param
# didn't work if it was set in a sub-class.
package My::CA;
use base 'CGI::Application';
sub cgiapp_init {
my $self = shift;
$self->mode_param('mine');
}
package main;
use Test::More tests => 1;
{
my $app = My::CA->new();
is( $app->mode_param, 'mine', "setting mode_param in a sub-class works");
}
CGI-Application-4.61/t/mode_param_path_info.t 000444 001750 001750 3760 13246212655 20672 0 ustar 00marto marto 000000 000000 use Test::More tests=>14;
# Include the test hierarchy
use lib 't/lib';
BEGIN { use_ok('TestApp5'); };
BEGIN { use_ok('CGI'); };
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
###
my $test_name = "mode_param( path_info => 1 ) with PATH_INFO set.";
$ENV{PATH_INFO} = '/basic_test1';
my $app = TestApp5->new;
$app->mode_param( path_info => 1 );
my $out;
eval { $out = $app->run() };
is($@, '', 'avoided eval() death');
like($out,qr/Hello World/, $test_name);
###
$test_name = "mode_param( path_info => 1 ) without PATH_INFO set, but with rm.";
$ENV{PATH_INFO} = '' ;
my $q = CGI->new({ rm => 'basic_test1' });
$app = TestApp5->new( QUERY => $q );
$app->mode_param( path_info => 1 );
eval { $out = $app->run() };
is($@, '', 'avoided eval() death');
like($out,qr/Hello World/, $test_name);
####
$test_name = "mode_param( param => 'alt_rm' ) ";
$ENV{PATH_INFO} = '';
$q = CGI->new({ alt_rm => 'basic_test1' });
$app = TestApp5->new( QUERY => $q );
$app->mode_param( param => 'alt_rm' );
eval { $out = $app->run() };
is($@, '', 'avoided eval() death');
like($out,qr/Hello World/, $test_name);
###
$test_name = "mode_param( path_info => 2 ), expecting success ";
$ENV{PATH_INFO} = '/my_ses_id/basic_test1/foo';
$app = TestApp5->new( QUERY => $q );
$app->mode_param( path_info => 2, );
eval { $out = $app->run() };
is($@, '', 'avoided eval() death');
like($out,qr/Hello World/, $test_name);
####
$test_name = "mode_param( path_info => 2, param => 'alt_rm' ), with path_info undef ";
$ENV{PATH_INFO} = '' ;
$app = TestApp5->new( QUERY => $q );
$app->mode_param( path_info => 2, param => 'alt_rm' );
eval { $out = $app->run() };
is($@, '', 'avoided eval() death');
like($out,qr/Hello World/, $test_name);
####
$test_name = "mode_param( path_info => -2 ), expecting success ";
$ENV{PATH_INFO} = '/my_ses_id/basic_test1/foo';
$app = TestApp5->new( QUERY => $q );
$app->mode_param( path_info => -2, );
eval { $out = $app->run() };
is($@, '', 'avoided eval() death');
like($out,qr/Hello World/, $test_name);
####
CGI-Application-4.61/t/postrun.t 000444 001750 001750 1763 13246212654 16251 0 ustar 00marto marto 000000 000000 use Test::More tests=>7;
# Include the test hierarchy
use lib 't/lib';
use CGI;
use TestCGI;
use TestApp9;
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
# Test making a modification to the output body
{
my $q = CGI->new({rm=>"postrun_body"});
my $app = TestApp9->new(QUERY=>$q);
my $output = $app->run();
like($output, qr/^Content\-Type\:\ text\/html/, "Postrun body has headers");
like($output, qr/Hello world: postrun_body/, "Hello world: postrun_body");
like($output, qr/postrun\ was\ here/, "Postrun was here");
}
# Test changing HTTP headers
{
my $q = CGI->new({rm=>"postrun_header"});
my $app = TestApp9->new(QUERY=>$q);
my $output = $app->run();
like($output, qr/^Status: 302/, "Postrun header is redirect");
like($output, qr/postrun.html/, "Postrun header is redirect to postrun.html");
like($output, qr/Hello world: postrun_header/, "Hello world: postrun_header");
unlike($output, qr/postrun\ was\ here/, "Postrun was NOT here");
}
CGI-Application-4.61/t/prerun.t 000444 001750 001750 3407 13246212654 16047 0 ustar 00marto marto 000000 000000 use Test::More tests => 10;
# Need CGI.pm for tests
use CGI;
# Include the test hierarchy
use lib 't/lib';
# Can we even use this module?
use_ok('TestApp6');
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
# Test basic cgiapp_prerun() and get_current_runmode()
{
my $ta_obj = TestApp6->new(QUERY=>CGI->new(""));
my $output = $ta_obj->run();
# Did the run mode work?
like($output, qr/^Content\-Type\:\ text\/html/);
like($output, qr/Hello\ World\:\ prerun\_test\ OK/);
# Did the cgiapp_prerun work?
is($ta_obj->param('PRERUN_RUNMODE'), 'prerun_test');
# get_current_runmode() working?
is($ta_obj->get_current_runmode(), 'prerun_test');
}
# Test basic prerun_mode()
{
local($^W) = undef; # Temporarily disable warnings
my $ta_obj = TestApp6->new(QUERY=>CGI->new('rm=prerun_mode_test'));
my $output = $ta_obj->run();
# Did the run mode work?
like($output, qr/^Content\-Type\:\ text\/html/);
# We will be in mode 'new_prerun_mode_test' if everything is working
like($output, qr/Hello\ World\:\ new\_prerun\_mode\_test\ OK/);
# get_current_runmode() working?
is($ta_obj->get_current_runmode(), 'new_prerun_mode_test');
}
# Test fail-case for prerun_mode()
{
my $ta_obj = TestApp6->new(QUERY=>CGI->new('rm=illegal_prerun_mode'));
eval {
my $output = $ta_obj->run();
};
my $eval_error = $@;
# Should result in an error
like($eval_error, qr/prerun\_mode\(\) can only be called within cgiapp\_prerun\(\)/);
}
# Test fail-case for prerun_mode() called from setup()
{
$ENV{PRERUN_IN_SETUP} = 1;
eval {
my $ta_obj = TestApp6->new(QUERY=>CGI->new(""));
};
my $eval_error = $@;
# Should result in an error
like($eval_error, qr/prerun\_mode\(\) can only be called within cgiapp\_prerun\(\)/);
}
###############
#### EOF ####
###############
CGI-Application-4.61/t/query.t 000444 001750 001750 761 13246212655 15662 0 ustar 00marto marto 000000 000000 # test the query() method
use Test::More 'no_plan';
use CGI;
# Include the test hierarchy
use lib 't/lib';
use TestApp14;
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
# Test query()
{
my $cgi = CGI->new('message=hello');
my $ta_obj = TestApp14->new(QUERY => $cgi);
my $output = $ta_obj->run();
like($output, qr/---->hello<----/);
my $cgi2 = CGI->new('message=goodbye');
$ta_obj->query($cgi2);
$output = $ta_obj->run();
like($output, qr/---->goodbye<----/);
}
CGI-Application-4.61/t/run_as_psgi.t 000444 001750 001750 2214 13246212654 17040 0 ustar 00marto marto 000000 000000
use Test::More;
use CGI::Application;
eval { require CGI::PSGI; };
# XXX, really, we need CGI::PSGI 0.09 or later.
if ($@) {
plan 'skip_all' => 'CGI::PSGI is not available';
}
else {
plan 'no_plan';
}
# Set up a CGI environment
my $env;
$env->{REQUEST_METHOD} = 'GET';
$env->{QUERY_STRING} = 'game=chess&game=checkers&weather=dull';
$env->{PATH_INFO} = '/somewhere/else';
$env->{PATH_TRANSLATED} = '/usr/local/somewhere/else';
$env->{SCRIPT_NAME} = '/cgi-bin/foo.cgi';
$env->{SERVER_PROTOCOL} = 'HTTP/1.0';
$env->{SERVER_PORT} = 8080;
$env->{SERVER_NAME} = 'the.good.ship.lollypop.com';
$env->{REQUEST_URI} = "$env->{SCRIPT_NAME}$env->{PATH_INFO}?$env->{QUERY_STRING}";
$env->{HTTP_LOVE} = 'true';
package TestApp;
use base 'CGI::Application';
sub setup {
my $self = shift;
$self->run_modes(
start => sub { 'Hello World' },
);
}
package main;
my $app = TestApp->new( QUERY => CGI::PSGI->new($env) );
my $response = $app->run_as_psgi;
is_deeply $response, [
'200',
[ 'Content-Type' => 'text/html; charset=ISO-8859-1' ],
[ 'Hello World' ],
],
"run_as_psgi: reality check basic response";
CGI-Application-4.61/t/zerorm.t 000444 001750 001750 476 13246212655 16036 0 ustar 00marto marto 000000 000000 use Test::More tests=>1;
use strict;
# Include the test hierarchy
use lib 't/lib';
use TestApp10;
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
# A runmode of '0' should be allowed
{
my $app = TestApp10->new;
my $output = $app->run();
like($output, qr/Success!$/, "Runmode 0 works");
}
CGI-Application-4.61/t/lib 000755 001750 001750 0 13246212655 14755 5 ustar 00marto marto 000000 000000 CGI-Application-4.61/t/lib/TestApp.pm 000444 001750 001750 6663 13246212654 17042 0 ustar 00marto marto 000000 000000 package TestApp;
use strict;
use CGI::Application;
@TestApp::ISA = qw(CGI::Application);
sub setup {
my $self = shift;
$self->start_mode('basic_test');
$self->mode_param('test_rm');
$self->run_modes(
'basic_test' => \&basic_test,
'redirect_test' => \&redirect_test,
'cookie_test' => \&cookie_test,
'tmpl_test' => \&tmpl_test,
'tmpl_badparam_test' => \&tmpl_badparam_test,
'props_before_redirect_test' => \&props_before_redirect_test,
'header_props_twice_nomerge' => \&header_props_twice_nomerge,
'header_add_arrayref_test' => \&header_add_arrayref_test,
'header_props_before_header_add' => \&header_props_before_header_add,
'header_add_after_header_props' => \&header_add_after_header_props,
'dump_htm' => 'dump_html',
'dump_txt' => 'dump',
'eval_test' => 'eval_test',
);
$self->param('last_orm', 'setup');
}
sub teardown {
my $self = shift;
$self->param('last_orm', 'teardown');
}
sub cgiapp_init {
my $self = shift;
$self->param('CGIAPP_INIT', 'true');
}
############################
#### RUN MODE METHODS ####
############################
sub basic_test {
my $self = shift;
return "Hello World: basic_test";
}
sub redirect_test {
my $self = shift;
$self->header_type('redirect');
$self->header_props(
-url => 'http://www.erlbaum.net/'
);
return "Hello World: redirect_test";
}
sub cookie_test {
my $self = shift;
my $q = $self->query();
my $cookie = $q->cookie(
-name => 'c_name',
-value => 'c_value',
-path => '/cookie_path_123',
-domain => 'some.cookie.dom',
-expires=>'-1y'
);
$self->header_props(
-cookie => $cookie
);
return "Hello World: cookie_test";
}
sub tmpl_test {
my $self = shift;
my $t = $self->load_tmpl('test.tmpl');
$t->param('ping', 'Hello World: tmpl_test');
return $t->output();
}
sub tmpl_badparam_test {
my $self = shift;
my $t = $self->load_tmpl('test.tmpl', die_on_bad_params => 0);
# This tests to see if die_on_bad_params was really turned off!
$t->param('some_non_existent_tmpl_var', 123);
$t->param('ping', 'Hello World: tmpl_badparam_test');
return $t->output();
}
sub eval_test {
my $self = shift;
die ("No cgi-app object '$self'") unless (ref($self));
return "Hello World: eval_test OK";
}
sub props_before_redirect_test {
my $self = shift;
$self->header_props(
'-Test' => 1,
'-url' => 'othersite.com',
);
$self->header_type('redirect');
return;
}
sub header_props_twice_nomerge {
my $self = shift;
$self->header_props(
'-Test' => 1,
'-Second-header' => 1,
);
$self->header_props(
'-Test' => 'Updated',
);
return 1;
}
sub header_add_arrayref_test {
my $self = shift;
$self->header_add(-cookie => ['cookie1=header_add; path=/', 'cookie2=header_add; path=/']);
return 1;
}
sub header_props_before_header_add {
my $self = shift;
$self->header_props(-cookie => 'cookie1=header_props; path=/');
$self->header_add(-cookie => ['cookie2=header_add; path=/']);
return 1;
}
sub header_props_after_header_add {
my $self = shift;
$self->header_add(-cookie => 'cookie1=header_add; path=/');
$self->header_props(-cookie => 'cookie2=header_props; path=/');
return 1;
}
sub header_add_after_header_props {
my $self = shift;
$self->header_props(-cookie => 'cookie1=header_props; path=/');
$self->header_add(-cookie => 'cookie2=header_add; path=/');
return 1;
}
1;
CGI-Application-4.61/t/lib/TestApp10.pm 000444 001750 001750 614 13246212654 17151 0 ustar 00marto marto 000000 000000 package TestApp10;
use strict;
use CGI::Application;
@TestApp10::ISA = qw(CGI::Application);
sub setup {
my $self = shift;
$self->run_modes({ AUTOLOAD => "handler" });
$self->start_mode( 0 );
}
sub handler {
my $self = shift;
my $rm = $self->get_current_runmode();
if ($rm eq "0") {
return "Success!";
} else {
return "Failure!";
}
}
1;
CGI-Application-4.61/t/lib/TestApp11.pm 000444 001750 001750 726 13246212654 17156 0 ustar 00marto marto 000000 000000 package TestApp11;
use strict;
use CGI::Application;
@TestApp11::ISA = qw(CGI::Application);
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
sub setup {
my $self = shift;
$self->run_modes( mode1 => "mode1" );
$self->start_mode( 'mode1' );
$self->error_mode( 'error' );
}
sub mode1 {
my $self = shift;
die "mode1 failed!\n";
}
sub error {
my $self = shift;
my ($error) = @_;
return "Success! Received '$error'";
}
1;
CGI-Application-4.61/t/lib/TestApp12.pm 000444 001750 001750 560 13246212655 17154 0 ustar 00marto marto 000000 000000 package TestApp12;
use strict;
use CGI::Application;
@TestApp12::ISA = qw(CGI::Application);
sub setup {
my $self = shift;
$self->run_modes( mode1 => "mode1" );
$self->start_mode( 'mode1' );
$self->error_mode( 'error' );
}
sub mode1 {
my $self = shift;
die "mode1 failed!\n";
}
sub error {
my $self = shift;
die "Oops!\n";
}
1;
CGI-Application-4.61/t/lib/TestApp13.pm 000444 001750 001750 2022 13246212654 17167 0 ustar 00marto marto 000000 000000 package TestApp13;
use strict;
use CGI::Application;
@TestApp13::ISA = qw(CGI::Application);
# Prevent output to STDOUT
$ENV{CGI_APP_RETURN_ONLY} = 1;
sub setup {
my $self = shift;
$self->run_modes( [ qw( mode1 mode2 ) ] );
$self->start_mode( 'mode1' );
$self->error_mode( 'error' );
}
sub mode1 {
my $self = shift;
my $file;
open ( $file, "t/lib/templates/test.tmpl" )
|| die "Cannot open testing template";
my $template = $self->load_tmpl( $file, 'die_on_bad_params' => 0 );
$template->param( 'ping' => "HELLO!" );
my $output = $template->output;
close ( $file );
$output;
}
sub mode2 {
my $self = shift;
my $template_string = <<_EOF_;
Simple Test
What's this:
_EOF_
my $template = $self->load_tmpl( \$template_string, 'die_on_bad_params' => 0 );
$template->param( 'ping' => 'HELLO!' );
$template->output;
}
sub error {
my $self = shift;
return "ERROR";
}
1;
CGI-Application-4.61/t/lib/TestApp14.pm 000444 001750 001750 761 13246212655 17161 0 ustar 00marto marto 000000 000000 package TestApp14;
use base 'CGI::Application';
use warnings;
use strict;
sub setup {
my $self = shift;
$self->run_modes([qw/ start /]);
$self->tmpl_path('t/lib/templates');
}
sub start {
my $self = shift;
my $t = $self->load_tmpl('test.tmpl');
$t->param(ping => scalar $self->query->param('message'));
return $t->output();
}
1;
CGI-Application-4.61/t/lib/TestApp2.pm 000444 001750 001750 152 13246212654 17067 0 ustar 00marto marto 000000 000000
package TestApp2;
use strict;
use TestApp;
@TestApp2::ISA = qw(TestApp);
# Test sub-inheritance
1;
CGI-Application-4.61/t/lib/TestApp3.pm 000444 001750 001750 1702 13246212655 17113 0 ustar 00marto marto 000000 000000
package TestApp3;
use strict;
use CGI::Application;
@TestApp3::ISA = qw(CGI::Application);
sub setup {
my $self = shift;
$self->start_mode('default_mode');
$self->mode_param(\&set_up_runmode);
$self->run_modes(
'subref_modeparam' => \&subref_modeparam_meth,
'0' => \&zero_mode,
'' => \&blank_mode,
'default_mode' => \&default_mode_meth,
);
}
sub set_up_runmode {
my $self = shift;
my $q = $self->query();
my $rm = $q->param('go_to_mode');
return undef if ($rm eq 'undef_rm');
return $rm;
}
############################
#### RUN MODE METHODS ####
############################
sub subref_modeparam_meth {
my $self = shift;
return "Hello World: subref_modeparam OK";
}
sub blank_mode {
my $self = shift;
return "Hello World: blank_mode OK";
}
sub zero_mode {
my $self = shift;
return "Hello World: zero_mode OK";
}
sub default_mode_meth {
my $self = shift;
return "Hello World: default_mode OK";
}
1;
CGI-Application-4.61/t/lib/TestApp4.pm 000444 001750 001750 1060 13246212654 17110 0 ustar 00marto marto 000000 000000
package TestApp4;
use strict;
use CGI::Application;
@TestApp4::ISA = qw(CGI::Application);
sub setup {
my $self = shift;
$self->start_mode('subref_test');
$self->run_modes(
'subref_test' => \&subref_test,
'AUTOLOAD' => \&autoload_meth
);
}
############################
#### RUN MODE METHODS ####
############################
sub subref_test {
my $self = shift;
my $output = "Hello World: subref_test OK";
return \$output;
}
sub autoload_meth {
my $self = shift;
my $real_rm = shift;
return "Hello World: $real_rm OK";
}
1;
CGI-Application-4.61/t/lib/TestApp5.pm 000444 001750 001750 1351 13246212654 17114 0 ustar 00marto marto 000000 000000
package TestApp5;
use strict;
use CGI::Application;
@TestApp5::ISA = qw(CGI::Application);
sub setup {
my $self = shift;
$self->start_mode('nomode');
$self->mode_param('rm');
$self->run_modes(
'basic_test1' => 'basic_test1',
'basic_test2' => 'badmode',
);
# Add more run modes. All should work now
$self->run_modes(
'basic_test2' => 'basic_test2',
'basic_test3' => 'basic_test3',
);
}
############################
#### RUN MODE METHODS ####
############################
sub basic_test1 {
my $self = shift;
return "Hello World: basic_test1";
}
sub basic_test2 {
my $self = shift;
return "Hello World: basic_test2";
}
sub basic_test3 {
my $self = shift;
return "Hello World: basic_test3";
}
1;
CGI-Application-4.61/t/lib/TestApp6.pm 000444 001750 001750 3026 13246212654 17116 0 ustar 00marto marto 000000 000000
package TestApp6;
use strict;
use CGI::Application;
@TestApp6::ISA = qw(CGI::Application);
sub setup {
my $self = shift;
$self->start_mode('prerun_test');
$self->run_modes(
# Test to make sure cgiapp_prerun() works
'prerun_test' => \&prerun_test,
# Test to make sure prerun_mode() works
'prerun_mode_test' => \&prerun_mode_test,
'new_prerun_mode_test' => \&new_prerun_mode_test,
# Test to make sure you can't do the wrong thing
'illegal_prerun_mode' => \&illegal_prerun_mode,
);
# Test for failure if prerun_mode is called in setup()
$self->prerun_mode('not_to_be_trifled_with') if ($ENV{PRERUN_IN_SETUP});
}
sub cgiapp_prerun {
my $self = shift;
my $rm = shift;
$self->param('PRERUN_RUNMODE', $rm);
if ($self->get_current_runmode() eq 'prerun_mode_test') {
# Override the current run mode
$self->prerun_mode('new_prerun_mode_test');
}
}
############################
#### RUN MODE METHODS ####
############################
sub prerun_test {
my $self = shift;
my $output = "Hello World: prerun_test OK";
return \$output;
}
sub prerun_mode_test {
my $self = shift;
my $output = "Hello World: prerun_mode_test OK";
return \$output;
}
sub new_prerun_mode_test {
my $self = shift;
my $output = "Hello World: new_prerun_mode_test OK";
return \$output;
}
sub illegal_prerun_mode {
my $self = shift;
# This should cause a fatal error
$self->prerun_mode('nothing_special');
# We should never get here
my $output = "Hello World: illegal_prerun_mode OK";
return \$output;
}
1;
CGI-Application-4.61/t/lib/TestApp7.pm 000444 001750 001750 673 13246212654 17104 0 ustar 00marto marto 000000 000000
package TestApp7;
use strict;
use CGI::Application;
@TestApp7::ISA = qw(CGI::Application);
use CGI::Carp;
sub setup {
my $self = shift;
$self->run_modes(
testcgi_mode => 'testcgi_mode'
);
}
sub cgiapp_get_query {
my $self = shift;
require TestCGI;
my $q = TestCGI->new();
return $q;
}
#### Run Mode Methods
sub testcgi_mode {
my $self = shift;
my $output = "Hello World: testcgi_mode OK";
return \$output;
}
1;
CGI-Application-4.61/t/lib/TestApp8.pm 000444 001750 001750 1163 13246212654 17120 0 ustar 00marto marto 000000 000000
package TestApp8;
use strict;
use CGI::Application;
@TestApp8::ISA = qw(CGI::Application);
sub setup {
my $self = shift;
# Test array-ref mode
$self->start_mode('testcgi1_mode');
$self->run_modes([qw/
testcgi1_mode
testcgi2_mode
testcgi3_mode
/]);
}
#### Run Mode Methods
sub testcgi1_mode {
my $self = shift;
my $output = "Hello World: testcgi1_mode OK";
return \$output;
}
sub testcgi2_mode {
my $self = shift;
my $output = "Hello World: testcgi2_mode OK";
return \$output;
}
sub testcgi3_mode {
my $self = shift;
my $output = "Hello World: testcgi3_mode OK";
return \$output;
}
1;
CGI-Application-4.61/t/lib/TestApp9.pm 000444 001750 001750 1560 13246212655 17123 0 ustar 00marto marto 000000 000000 package TestApp9;
use strict;
use CGI::Application;
@TestApp9::ISA = qw(CGI::Application);
sub setup {
my $self = shift;
$self->run_modes([qw(
noheader
postrun_body
postrun_header
)]);
}
sub cgiapp_postrun {
my $self = shift;
my $output_ref = shift;
my $rm = $self->get_current_runmode();
if ($rm eq "postrun_body") {
$$output_ref .= "\npostrun was here";
} elsif ($rm eq "postrun_header") {
$self->header_type("redirect");
$self->header_props(-url=>"postrun.html");
}
}
sub noheader {
my $self = shift;
$self->header_type('none');
return "Hello world: noheader";
}
sub postrun_body {
return "Hello world: postrun_body";
}
sub postrun_header {
return "Hello world: postrun_header";
}
1;
CGI-Application-4.61/t/lib/TestCGI.pm 000444 001750 001750 1075 13246212654 16714 0 ustar 00marto marto 000000 000000 package TestCGI;
use CGI;
use CGI::Carp;
sub new {
my $pkg = shift;
my $self = {};
bless($self, $pkg);
my $q = CGI->new();
$self->{CGI} = $q;
# Set test value
$q->param('rm', 'testcgi_mode');
return $self;
}
sub header {
my $self = shift;
# carp("TestCGI proxy method 'header'");
return $self->{CGI}->header(@_);
}
sub redirect {
my $self = shift;
# carp("TestCGI proxy method 'redirect'");
return $self->{CGI}->redirect(@_);
}
sub param {
my $self = shift;
# carp("TestCGI proxy method 'param'");
return $self->{CGI}->param(@_);
}
1;
CGI-Application-4.61/t/lib/templates 000755 001750 001750 0 13246212654 16752 5 ustar 00marto marto 000000 000000 CGI-Application-4.61/t/lib/templates/test.tmpl 000444 001750 001750 42 13246212654 20720 0 ustar 00marto marto 000000 000000 ----><----