CGI-Application-4.61000755001750001750 013246212655 13744 5ustar00martomarto000000000000CGI-Application-4.61/.travis.yml000444001750001750 37613246212655 16200 0ustar00martomarto000000000000language: 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/ARTISTIC000444001750001750 1373713246212655 15301 0ustar00martomarto000000000000 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.PL000444001750001750 223013246212654 15371 0ustar00martomarto000000000000use 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/Changes000444001750001750 4402313246212655 15417 0ustar00martomarto000000000000Revision 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/GPL000444001750001750 4310113246212654 14464 0ustar00martomarto000000000000 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/MANIFEST000444001750001750 147713246212655 15243 0ustar00martomarto000000000000.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.json000444001750001750 331613246212654 15524 0ustar00martomarto000000000000{ "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.yml000444001750001750 221213246212654 15346 0ustar00martomarto000000000000--- 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.PL000444001750001750 115313246212654 16052 0ustar00martomarto000000000000# 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/README000444001750001750 417313246212654 14765 0ustar00martomarto000000000000######################################################################### ## 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/Examples000755001750001750 013246212654 15521 5ustar00martomarto000000000000CGI-Application-4.61/Examples/Mailform000755001750001750 013246212655 17270 5ustar00martomarto000000000000CGI-Application-4.61/Examples/Mailform/README000444001750001750 57313246212655 20272 0ustar00martomarto000000000000The 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.cgi000444001750001750 261713246212654 21724 0ustar00martomarto000000000000#!/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.html000444001750001750 527013246212654 22124 0ustar00martomarto000000000000 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/

Name:
Email Address:
Company:
Postal Address:
CGI::Application::Mailform is:
Perl is: Great! SuperFabulastic!
Would you like Jesse to sing you Happy Birthday? Yes, please!
CGI-Application-4.61/Examples/Mailform/thankyou.html000444001750001750 74413246212654 22141 0ustar00martomarto000000000000 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/lib000755001750001750 013246212654 14511 5ustar00martomarto000000000000CGI-Application-4.61/lib/CGI000755001750001750 013246212655 15114 5ustar00martomarto000000000000CGI-Application-4.61/lib/CGI/Application.pm000444001750001750 23743013246212655 20123 0ustar00martomarto000000000000package 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 .= "

Current Run-mode: '$current_runmode'

\n"; # Dump Params $output .= "

Query Parameters:

\n"; $output .= $query->Dump; # Dump ENV $output .= "

Query Environment:

\n
    \n"; foreach my $ek ( sort( keys( %ENV ) ) ) { $output .= sprintf( "
  1. %s => '%s'
  2. \n", $query->escapeHTML( $ek ), $query->escapeHTML( $ENV{$ek} ) ); } $output .= "
\n"; return $output; } sub no_runmodes { my $self = shift; my $query = $self->query(); my $output = $query->start_html; # If no runmodes specified by app return error message my $current_runmode = $self->get_current_runmode(); my $query_params = $query->Dump; $output .= qq{

Error - No runmodes specified.

Runmode called: $current_runmode"

Query paramaters:

$query_params

Your application has not specified any runmodes.

Please read the CGI::Application documentation.

}; $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 portion of the PSGI spec. to handle the input, you need to use a CGI.pm-like query object that is PSGI-compliant, such as L. This query object must provide L and L methods. The final result might look like this: use WebApp; use CGI::PSGI; my $handler = sub { my $env = shift; my $webapp = WebApp->new({ QUERY => CGI::PSGI->new($env) }); $webapp->run_as_psgi; }; =head2 Additional PSGI Return Values The PSGI Specification allows for returning a file handle or a subroutine reference instead of byte strings. In PSGI mode this is supported directly by CGI::Application. Have your run mode return a file handle or compatible subref as follows: sub returning_a_file_handle { my $self = shift; $self->header_props(-type => 'text/plain'); open my $fh, "<", 'test_file.txt' or die "OOPS! $!"; return $fh; } sub returning_a_subref { my $self = shift; $self->header_props(-type => 'text/plain'); return sub { my $writer = shift; foreach my $i (1..10) { #sleep 1; $writer->write("check $i: " . time . "\n"); } }; } =head2 Methods to possibly override CGI::Application implements some methods which are expected to be overridden by implementing them in your sub-class module. These methods are as follows: =head3 setup() This method is called by the inherited new() constructor method. The setup() method should be used to define the following property/methods: mode_param() - set the name of the run mode CGI param. start_mode() - text scalar containing the default run mode. error_mode() - text scalar containing the error mode. run_modes() - hash table containing mode => function mappings. tmpl_path() - text scalar or array reference containing path(s) to template files. Your setup() method may call any of the instance methods of your application. This function is a good place to define properties specific to your application via the $webapp->param() method. Your setup() method might be implemented something like this: sub setup { my $self = shift; $self->tmpl_path('/path/to/my/templates/'); $self->start_mode('putform'); $self->error_mode('my_error_rm'); $self->run_modes({ 'putform' => 'my_putform_func', 'postdata' => 'my_data_func' }); $self->param('myprop1'); $self->param('myprop2', 'prop2value'); $self->param('myprop3', ['p3v1', 'p3v2', 'p3v3']); } However, often times all that needs to be in setup() is defining your run modes and your start mode. L allows you to do this with a simple syntax, using run mode attributes: use CGI::Application::Plugin::AutoRunmode; sub show_first : StartRunmode { ... }; sub do_next : Runmode { ... } =head3 teardown() If implemented, this method is called automatically after your application runs. It can be used to clean up after your operations. A typical use of the teardown() function is to disconnect a database connection which was established in the setup() function. You could also use the teardown() method to store state information about the application to the server. =head3 cgiapp_init() If implemented, this method is called automatically right before the setup() method is called. This method provides an optional initialization hook, which improves the object-oriented characteristics of CGI::Application. The cgiapp_init() method receives, as its parameters, all the arguments which were sent to the new() method. An example of the benefits provided by utilizing this hook is creating a custom "application super-class" from which all your web applications would inherit, instead of CGI::Application. Consider the following: # In MySuperclass.pm: package MySuperclass; use base 'CGI::Application'; sub cgiapp_init { my $self = shift; # Perform some project-specific init behavior # such as to load settings from a database or file. } # In MyApplication.pm: package MyApplication; use base 'MySuperclass'; sub setup { ... } sub teardown { ... } # The rest of your CGI::Application-based follows... By using CGI::Application and the cgiapp_init() method as illustrated, a suite of applications could be designed to share certain characteristics. This has the potential for much cleaner code built on object-oriented inheritance. =head3 cgiapp_prerun() If implemented, this method is called automatically right before the selected run mode method is called. This method provides an optional pre-runmode hook, which permits functionality to be added at the point right before the run mode method is called. To further leverage this hook, the value of the run mode is passed into cgiapp_prerun(). Another benefit provided by utilizing this hook is creating a custom "application super-class" from which all your web applications would inherit, instead of CGI::Application. Consider the following: # In MySuperclass.pm: package MySuperclass; use base 'CGI::Application'; sub cgiapp_prerun { my $self = shift; # Perform some project-specific init behavior # such as to implement run mode specific # authorization functions. } # In MyApplication.pm: package MyApplication; use base 'MySuperclass'; sub setup { ... } sub teardown { ... } # The rest of your CGI::Application-based follows... By using CGI::Application and the cgiapp_prerun() method as illustrated, a suite of applications could be designed to share certain characteristics. This has the potential for much cleaner code built on object-oriented inheritance. It is also possible, within your cgiapp_prerun() method, to change the run mode of your application. This can be done via the prerun_mode() method, which is discussed elsewhere in this POD. =head3 cgiapp_postrun() If implemented, this hook will be called after the run mode method has returned its output, but before HTTP headers are generated. This will give you an opportunity to modify the body and headers before they are returned to the web browser. A typical use for this hook is pipelining the output of a CGI-Application through a series of "filter" processors. For example: * You want to enclose the output of all your CGI-Applications in an HTML table in a larger page. * Your run modes return structured data (such as XML), which you want to transform using a standard mechanism (such as XSLT). * You want to post-process CGI-App output through another system, such as HTML::Mason. * You want to modify HTTP headers in a particular way across all run modes, based on particular criteria. The cgiapp_postrun() hook receives a reference to the output from your run mode method, in addition to the CGI-App object. A typical cgiapp_postrun() method might be implemented as follows: sub cgiapp_postrun { my $self = shift; my $output_ref = shift; # Enclose output HTML table my $new_output = ""; $new_output .= ""; $new_output .= ""; $new_output .= "
Hello, World!
". $$output_ref ."
"; # Replace old output with new output $$output_ref = $new_output; } Obviously, with access to the CGI-App object you have full access to use all the methods normally available in a run mode. You could, for example, use C to replace the static HTML in this example with HTML::Template. You could change the HTTP headers (via C and C methods) to set up a redirect. You could also use the objects properties to apply changes only under certain circumstance, such as a in only certain run modes, and when a C is a particular value. =head3 cgiapp_get_query() my $q = $webapp->cgiapp_get_query; Override this method to retrieve the query object if you wish to use a different query interface instead of CGI.pm. CGI.pm is only loaded if it is used on a given request. If you can use an alternative to CGI.pm, it needs to have some compatibility with the CGI.pm API. For normal use, just having a compatible C method should be sufficient. If you use the C option to the mode_param() method, then we will call the C method on the query object. If you use the C method in CGI::Application, we will call the C and C methods on the query object. =head2 Essential Application Methods The following methods are inherited from CGI::Application, and are available to be called by your application within your Application Module. They are called essential because you will use all are most of them to get any application up and running. These functions are listed in alphabetical order. =head3 load_tmpl() my $tmpl_obj = $webapp->load_tmpl; my $tmpl_obj = $webapp->load_tmpl('some.html'); my $tmpl_obj = $webapp->load_tmpl( \$template_content ); my $tmpl_obj = $webapp->load_tmpl( FILEHANDLE ); This method takes the name of a template file, a reference to template data or a FILEHANDLE and returns an HTML::Template object. If the filename is undefined or missing, CGI::Application will default to trying to use the current run mode name, plus the extension ".html". If you use the default template naming system, you should also use L, which simply helps to keep the current name accurate when you pass control from one run mode to another. ( For integration with other template systems and automated template names, see "Alternatives to load_tmpl() below. ) When you pass in a filename, the HTML::Template->new_file() constructor is used for create the object. When you pass in a reference to the template content, the HTML::Template->new_scalar_ref() constructor is used and when you pass in a filehandle, the HTML::Template->new_filehandle() constructor is used. Refer to L for specific usage of HTML::Template. If tmpl_path() has been specified, load_tmpl() will set the HTML::Template C option to the path(s) provided. This further assists in encapsulating template usage. The load_tmpl() method will pass any extra parameters sent to it directly to HTML::Template->new_file() (or new_scalar_ref() or new_filehandle()). This will allow the HTML::Template object to be further customized: my $tmpl_obj = $webapp->load_tmpl('some_other.html', die_on_bad_params => 0, cache => 1 ); Note that if you want to pass extra arguments but use the default template name, you still need to provide a name of C: my $tmpl_obj = $webapp->load_tmpl(undef, die_on_bad_params => 0, cache => 1 ); B If your application requires more specialized behavior than this, you can always replace it by overriding load_tmpl() by implementing your own load_tmpl() in your CGI::Application sub-class application module. First, you may want to check out the template related plugins. L focuses just on Template Toolkit integration, and features pre-and-post features, singleton support and more. L can help if you want to return a stream and not a file. It features a simple syntax and MIME-type detection. B You may specify an API-compatible alternative to L by setting a new C: $self->html_tmpl_class('HTML::Template::Dumper'); The default is "HTML::Template". The alternate class should provide at least the following parts of the HTML::Template API: $t = $class->new( scalarref => ... ); # If you use scalarref templates $t = $class->new( filehandle => ... ); # If you use filehandle templates $t = $class->new( filename => ... ); $t->param(...); Here's an example case allowing you to precisely test what's sent to your templates: $ENV{CGI_APP_RETURN_ONLY} = 1; my $webapp = WebApp->new; $webapp->html_tmpl_class('HTML::Template::Dumper'); my $out_str = $webapp->run; my $tmpl_href = eval "$out_str"; # Now Precisely test what would be set to the template is ($tmpl_href->{pet_name}, 'Daisy', "Daisy is sent template"); This is a powerful technique because HTML::Template::Dumper loads and considers the template file that would actually be used. If the 'pet_name' token was missing in the template, the above test would fail. So, you are testing both your code and your templates in a much more precise way than using simple regular expressions to see if the string "Daisy" appeared somewhere on the page. B Plugin authors will be interested to know that you can register a callback that will be executed just before load_tmpl() returns: $self->add_callback('load_tmpl',\&your_method); When C is executed, it will be passed three arguments: 1. A hash reference of the extra params passed into C 2. Followed by a hash reference to template parameters. With both of these, you can modify them by reference to affect values that are actually passed to the new() and param() methods of the template object. 3. The name of the template file. Here's an example stub for a load_tmpl() callback: sub my_load_tmpl_callback { my ($c, $ht_params, $tmpl_params, $tmpl_file) = @_ # modify $ht_params or $tmpl_params by reference... } =head3 param() $webapp->param('pname', $somevalue); The param() method provides a facility through which you may set application instance properties which are accessible throughout your application. The param() method may be used in two basic ways. First, you may use it to get or set the value of a parameter: $webapp->param('scalar_param', '123'); my $scalar_param_values = $webapp->param('some_param'); Second, when called in the context of an array, with no parameter name specified, param() returns an array containing all the parameters which currently exist: my @all_params = $webapp->param(); The param() method also allows you to set a bunch of parameters at once by passing in a hash (or hashref): $webapp->param( 'key1' => 'val1', 'key2' => 'val2', 'key3' => 'val3', ); The param() method enables a very valuable system for customizing your applications on a per-instance basis. One Application Module might be instantiated by different Instance Scripts. Each Instance Script might set different values for a set of parameters. This allows similar applications to share a common code-base, but behave differently. For example, imagine a mail form application with a single Application Module, but multiple Instance Scripts. Each Instance Script might specify a different recipient. Another example would be a web bulletin boards system. There could be multiple boards, each with a different topic and set of administrators. The new() method provides a shortcut for specifying a number of run-time parameters at once. Internally, CGI::Application calls the param() method to set these properties. The param() method is a powerful tool for greatly increasing your application's re-usability. =head3 query() my $q = $webapp->query(); my $remote_user = $q->remote_user(); This method retrieves the CGI.pm query object which has been created by instantiating your Application Module. For details on usage of this query object, refer to L. CGI::Application is built on the CGI module. Generally speaking, you will want to become very familiar with CGI.pm, as you will use the query object whenever you want to interact with form data. When the new() method is called, a CGI query object is automatically created. If, for some reason, you want to use your own CGI query object, the new() method supports passing in your existing query object on construction using the QUERY attribute. There are a few rare situations where you want your own query object to be used after your Application Module has already been constructed. In that case you can pass it to c like this: $webapp->query($new_query_object); my $q = $webapp->query(); # now uses $new_query_object =head3 run_modes() # The common usage: an arrayref of run mode names that exactly match subroutine names $webapp->run_modes([qw/ form_display form_process /]); # With a hashref, use a different name or a code ref $webapp->run_modes( 'mode1' => 'some_sub_by_name', 'mode2' => \&some_other_sub_by_ref ); This accessor/mutator specifies the dispatch table for the application states, using the syntax examples above. It returns the dispatch table as a hash. The run_modes() method may be called more than once. Additional values passed into run_modes() will be added to the run modes table. In the case that an existing run mode is re-defined, the new value will override the existing value. This behavior might be useful for applications which are created via inheritance from another application, or some advanced application which modifies its own capabilities based on user input. The run() method uses the data in this table to send the application to the correct function as determined by reading the CGI parameter specified by mode_param() (defaults to 'rm' for "Run Mode"). These functions are referred to as "run mode methods". The hash table set by this method is expected to contain the mode name as a key. The value should be either a hard reference (a subref) to the run mode method which you want to be called when the application enters the specified run mode, or the name of the run mode method to be called: 'mode_name_by_ref' => \&mode_function 'mode_name_by_name' => 'mode_function' The run mode method specified is expected to return a block of text (e.g.: HTML) which will eventually be sent back to the web browser. The run mode method may return its block of text as a scalar or a scalar-ref. An advantage of specifying your run mode methods by name instead of by reference is that you can more easily create derivative applications using inheritance. For instance, if you have a new application which is exactly the same as an existing application with the exception of one run mode, you could simply inherit from that other application and override the run mode method which is different. If you specified your run mode method by reference, your child class would still use the function from the parent class. An advantage of specifying your run mode methods by reference instead of by name is performance. Dereferencing a subref is faster than eval()-ing a code block. If run-time performance is a critical issue, specify your run mode methods by reference and not by name. The speed differences are generally small, however, so specifying by name is preferred. Specifying the run modes by array reference: $webapp->run_modes([ 'mode1', 'mode2', 'mode3' ]); This is the same as using a hash, with keys equal to values $webapp->run_modes( 'mode1' => 'mode1', 'mode2' => 'mode2', 'mode3' => 'mode3' ); Often, it makes good organizational sense to have your run modes map to methods of the same name. The array-ref interface provides a shortcut to that behavior while reducing verbosity of your code. Note that another importance of specifying your run modes in either a hash or array-ref is to assure that only those Perl methods which are specifically designated may be called via your application. Application environments which don't specify allowed methods and disallow all others are insecure, potentially opening the door to allowing execution of arbitrary code. CGI::Application maintains a strict "default-deny" stance on all method invocation, thereby allowing secure applications to be built upon it. B Your application should *NEVER* print() to STDOUT. Using print() to send output to STDOUT (including HTTP headers) is exclusively the domain of the inherited run() method. Breaking this rule is a common source of errors. If your program is erroneously sending content before your HTTP header, you are probably breaking this rule. B If CGI::Application is asked to go to a run mode which doesn't exist it will usually croak() with errors. If this is not your desired behavior, it is possible to catch this exception by implementing a run mode with the reserved name "AUTOLOAD": $self->run_modes( "AUTOLOAD" => \&catch_my_exception ); Before CGI::Application calls croak() it will check for the existence of a run mode called "AUTOLOAD". If specified, this run mode will in invoked just like a regular run mode, with one exception: It will receive, as an argument, the name of the run mode which invoked it: sub catch_my_exception { my $self = shift; my $intended_runmode = shift; my $output = "Looking for '$intended_runmode', but found 'AUTOLOAD' instead"; return $output; } This functionality could be used for a simple human-readable error screen, or for more sophisticated application behaviors. =head3 start_mode() $webapp->start_mode('mode1'); The start_mode contains the name of the mode as specified in the run_modes() table. Default mode is "start". The mode key specified here will be used whenever the value of the CGI form parameter specified by mode_param() is not defined. Generally, this is the first time your application is executed. =head3 tmpl_path() $webapp->tmpl_path('/path/to/some/templates/'); This access/mutator method sets the file path to the directory (or directories) where the templates are stored. It is used by load_tmpl() to find the template files, using HTML::Template's C option. To set the path you can either pass in a text scalar or an array reference of multiple paths. =head2 More Application Methods You can skip this section if you are just getting started. The following additional methods are inherited from CGI::Application, and are available to be called by your application within your Application Module. These functions are listed in alphabetical order. =head3 delete() $webapp->delete('my_param'); The delete() method is used to delete a parameter that was previously stored inside of your application either by using the PARAMS hash that was passed in your call to new() or by a call to the param() method. This is similar to the delete() method of CGI.pm. It is useful if your application makes decisions based on the existence of certain params that may have been removed in previous sections of your app or simply to clean-up your param()s. =head3 dump() print STDERR $webapp->dump(); The dump() method is a debugging function which will return a chunk of text which contains all the environment and web form data of the request, formatted nicely for human readability. Useful for outputting to STDERR. =head3 dump_html() my $output = $webapp->dump_html(); The dump_html() method is a debugging function which will return a chunk of text which contains all the environment and web form data of the request, formatted nicely for human readability via a web browser. Useful for outputting to a browser. Please consider the security implications of using this in production code. =head3 error_mode() $webapp->error_mode('my_error_rm'); If the runmode dies for whatever reason, C see if you have set a value for C. If you have, C will call that method as a run mode, passing $@ as the only parameter. Plugins authors will be interested to know that just before C is called, the C hook will be executed, with the error message passed in as the only parameter. No C is defined by default. The death of your C run mode is not trapped, so you can also use it to die in your own special way. For a complete integrated logging solution, check out L. =head3 get_current_runmode() $webapp->get_current_runmode(); The C method will return a text scalar containing the name of the run mode which is currently being executed. If the run mode has not yet been determined, such as during setup(), this method will return undef. =head3 header_add() # add or replace the 'type' header $webapp->header_add( -type => 'image/png' ); - or - # add an additional cookie $webapp->header_add(-cookie=>[$extra_cookie]); The C method is used to add one or more headers to the outgoing response headers. The parameters will eventually be passed on to the CGI.pm header() method, so refer to the L docs for exact usage details. Unlike calling C, C will preserve any existing headers. If a scalar value is passed to C it will replace the existing value for that key. If an array reference is passed as a value to C, values in that array ref will be appended to any existing values for that key. This is primarily useful for setting an additional cookie after one has already been set. =head3 header_props() # Set a complete set of headers %set_headers = $webapp->header_props(-type=>'image/gif',-expires=>'+3d'); # clobber / reset all headers %set_headers = $webapp->header_props({}); # Just retrieve the headers %set_headers = $webapp->header_props(); The C method expects a hash of CGI.pm-compatible HTTP header properties. These properties will be passed directly to the C or C methods of the query() object. Refer to the docs of your query object for details. (Be default, it's L.pm). Calling header_props with an empty hashref clobber any existing headers that have previously set. C returns a hash of all the headers that have currently been set. It can be called with no arguments just to get the hash current headers back. To add additional headers later without clobbering the old ones, see C. B It is through the C and C method that you may modify the outgoing HTTP headers. This is necessary when you want to set a cookie, set the mime type to something other than "text/html", or perform a redirect. The header_props() method works in conjunction with the header_type() method. The value contained in header_type() determines if we use CGI::header() or CGI::redirect(). The content of header_props() is passed as an argument to whichever CGI.pm function is called. Understanding this relationship is important if you wish to manipulate the HTTP header properly. =head3 header_type() $webapp->header_type('redirect'); $webapp->header_type('none'); This method used to declare that you are setting a redirection header, or that you want no header to be returned by the framework. The value of 'header' is almost never used, as it is the default. B: sub some_redirect_mode { my $self = shift; # do stuff here.... $self->header_type('redirect'); $self->header_props(-url=> "http://site/path/doc.html" ); } To simplify that further, use L: return $self->redirect('http://www.example.com/'); Setting the header to 'none' may be useful if you are streaming content. In other contexts, it may be more useful to set C<$ENV{CGI_APP_RETURN_ONLY} = 1;>, which suppresses all printing, including headers, and returns the output instead. That's commonly used for testing, or when using L as a controller for a cron script! =cut sub html_tmpl_class { my $self = shift; my $tmpl_class = shift; # First use? Create new __ERROR_MODE $self->{__HTML_TMPL_CLASS} = 'HTML::Template' unless (exists($self->{__HTML_TMPL_CLASS})); if (defined $tmpl_class) { $self->{__HTML_TMPL_CLASS} = $tmpl_class; } return $self->{__HTML_TMPL_CLASS}; } sub load_tmpl { my $self = shift; my ($tmpl_file, @extra_params) = @_; # add tmpl_path to path array if one is set, otherwise add a path arg if (my $tmpl_path = $self->tmpl_path) { my @tmpl_paths = (ref $tmpl_path eq 'ARRAY') ? @$tmpl_path : $tmpl_path; my $found = 0; for( my $x = 0; $x < @extra_params; $x += 2 ) { if ($extra_params[$x] eq 'path' and ref $extra_params[$x+1] eq 'ARRAY') { unshift @{$extra_params[$x+1]}, @tmpl_paths; $found = 1; last; } } push(@extra_params, path => [ @tmpl_paths ]) unless $found; } my %tmpl_params = (); my %ht_params = @extra_params; %ht_params = () unless keys %ht_params; # Define our extension if doesn't already exist; $self->{__CURRENT_TMPL_EXTENSION} = '.html' unless defined $self->{__CURRENT_TMPL_EXTENSION}; # Define a default template name based on the current run mode unless (defined $tmpl_file) { $tmpl_file = $self->get_current_runmode . $self->{__CURRENT_TMPL_EXTENSION}; } $self->call_hook('load_tmpl', \%ht_params, \%tmpl_params, $tmpl_file); my $ht_class = $self->html_tmpl_class; eval "require $ht_class;" || die "require $ht_class failed: $@"; # let's check $tmpl_file and see what kind of parameter it is - we # now support 3 options: scalar (filename), ref to scalar (the # actual html/template content) and reference to FILEHANDLE my $t = undef; if ( ref $tmpl_file eq 'SCALAR' ) { $t = $ht_class->new( scalarref => $tmpl_file, %ht_params ); } elsif ( ref $tmpl_file eq 'GLOB' ) { $t = $ht_class->new( filehandle => $tmpl_file, %ht_params ); } else { $t = $ht_class->new( filename => $tmpl_file, %ht_params); } if (keys %tmpl_params) { $t->param(%tmpl_params); } return $t; } =pod =head3 mode_param() # Name the CGI form parameter that contains the run mode name. # This is the default behavior, and is often sufficient. $webapp->mode_param('rm'); # Set the run mode name directly from a code ref $webapp->mode_param(\&some_method); # Alternate interface, which allows you to set the run # mode name directly from $ENV{PATH_INFO}. $webapp->mode_param( path_info=> 1, param =>'rm' ); This accessor/mutator method is generally called in the setup() method. It is used to help determine the run mode to call. There are three options for calling it. $webapp->mode_param('rm'); Here, a CGI form parameter is named that will contain the name of the run mode to use. This is the default behavior, with 'rm' being the parameter named used. $webapp->mode_param(\&some_method); Here a code reference is provided. It will return the name of the run mode to use directly. Example: sub some_method { my $self = shift; return 'run_mode_x'; } This would allow you to programmatically set the run mode based on arbitrary logic. $webapp->mode_param( path_info=> 1, param =>'rm' ); This syntax allows you to easily set the run mode from $ENV{PATH_INFO}. It will try to set the run mode from the first part of $ENV{PATH_INFO} (before the first "/"). To specify that you would rather get the run mode name from the 2nd part of $ENV{PATH_INFO}: $webapp->mode_param( path_info=> 2 ); This also demonstrates that you don't need to pass in the C hash key. It will still default to C. You can also set C to a negative value. This works just like a negative list index: if it is -1 the run mode name will be taken from the last part of $ENV{PATH_INFO}, if it is -2, the one before that, and so on. If no run mode is found in $ENV{PATH_INFO}, it will fall back to looking in the value of a the CGI form field defined with 'param', as described above. This allows you to use the convenient $ENV{PATH_INFO} trick most of the time, but also supports the edge cases, such as when you don't know what the run mode will be ahead of time and want to define it with JavaScript. B. Using $ENV{PATH_INFO} to name your run mode creates a clean separation between the form variables you submit and how you determine the processing run mode. It also creates URLs that are more search engine friendly. Let's look at an example form submission using this syntax:
Here the run mode would be set to "edit_form". Here's another example with a query string: /cgi-bin/instance.cgi/edit_form?breed_id=2 This demonstrates that you can use $ENV{PATH_INFO} and a query string together without problems. $ENV{PATH_INFO} is defined as part of the CGI specification should be supported by any web server that supports CGI scripts. =cut sub mode_param { my $self = shift; my $mode_param; # First use? Create new __MODE_PARAM $self->{__MODE_PARAM} = 'rm' unless (exists($self->{__MODE_PARAM})); my %p; # expecting a scalar or code ref if ((scalar @_) == 1) { $mode_param = $_[0]; } # expecting hash style params else { croak("CGI::Application->mode_param() : You gave me an odd number of parameters to mode_param()!") unless ((@_ % 2) == 0); %p = @_; $mode_param = $p{param}; if ( $p{path_info} && $self->query->path_info() ) { my $pi = $self->query->path_info(); my $idx = $p{path_info}; # two cases: negative or positive index # negative index counts from the end of path_info # positive index needs to be fixed because # computer scientists like to start counting from zero. $idx -= 1 if ($idx > 0) ; # remove the leading slash $pi =~ s!^/!!; # grab the requested field location $pi = (split q'/', $pi)[$idx] || ''; $mode_param = (length $pi) ? { run_mode => $pi } : $mode_param; } } # If data is provided, set it if (defined $mode_param and length $mode_param) { $self->{__MODE_PARAM} = $mode_param; } return $self->{__MODE_PARAM}; } =head3 prerun_mode() $webapp->prerun_mode('new_run_mode'); The prerun_mode() method is an accessor/mutator which can be used within your cgiapp_prerun() method to change the run mode which is about to be executed. For example, consider: # In WebApp.pm: package WebApp; use base 'CGI::Application'; sub cgiapp_prerun { my $self = shift; # Get the web user name, if any my $q = $self->query(); my $user = $q->remote_user(); # Redirect to login, if necessary unless ($user) { $self->prerun_mode('login'); } } In this example, the web user will be forced into the "login" run mode unless they have already logged in. The prerun_mode() method permits a scalar text string to be set which overrides whatever the run mode would otherwise be. The use of prerun_mode() within cgiapp_prerun() differs from setting mode_param() to use a call-back via subroutine reference. It differs because cgiapp_prerun() allows you to selectively set the run mode based on some logic in your cgiapp_prerun() method. The call-back facility of mode_param() forces you to entirely replace CGI::Application's mechanism for determining the run mode with your own method. The prerun_mode() method should be used in cases where you want to use CGI::Application's normal run mode switching facility, but you want to make selective changes to the mode under specific conditions. B The prerun_mode() method may ONLY be called in the context of a cgiapp_prerun() method. Your application will die() if you call prerun_mode() elsewhere, such as in setup() or a run mode method. =head2 Dispatching Clean URIs to run modes Modern web frameworks dispense with cruft in URIs, providing in clean URIs instead. Instead of: /cgi-bin/item.cgi?rm=view&id=15 A clean URI to describe the same resource might be: /item/15/view The process of mapping these URIs to run modes is called dispatching and is handled by L. Dispatching is not required and is a layer you can fairly easily add to an application later. =head2 Offline website development You can work on your CGI::Application project on your desktop or laptop without installing a full-featured web-server like Apache. Instead, install L from CPAN. After a few minutes of setup, you'll have your own private application server up and running. =head2 Automated Testing L allows functional testing of a CGI::App-based project without starting a web server. L could be used to test the app through a real web server. Direct testing is also easy. CGI::Application will normally print the output of it's run modes directly to STDOUT. This can be suppressed with an environment variable, CGI_APP_RETURN_ONLY. For example: $ENV{CGI_APP_RETURN_ONLY} = 1; $output = $webapp->run(); like($output, qr/good/, "output is good"); Examples of this style can be seen in our own test suite. =head1 PLUG-INS CGI::Application has a plug-in architecture that is easy to use and easy to develop new plug-ins for. =head2 Recommended Plug-ins The following plugins are recommended for general purpose web/db development: =over 4 =item * L - is a simple plugin to provide a shorter syntax for executing a redirect. =item * L - Keeping your config details in a separate file is recommended for every project. This one integrates with L. Several more config plugin options are listed below. =item * L - Provides easy management of one or more database handles and can delay making the database connection until the moment it is actually used. =item * L - makes it a breeze to fill in an HTML form from data originating from a CGI query or a database record. =item * L - For a project that requires session management, this plugin provides a useful wrapper around L =item * L - Integration with Data::FormValidator and HTML::FillInForm =back =head2 More plug-ins Many more plugins are available as alternatives and for specific uses. For a current complete list, please consult CPAN: http://search.cpan.org/search?m=dist&q=CGI%2DApplication%2DPlugin =over 4 =item * L - Use any templating system from within CGI::Application using a unified interface =item * L - Use Apache::* modules without interference =item * L - Automatically register runmodes =item * L - Integration with L. =item * L - Integration with L. =item * L - Integration with L. =item * L - Add Gzip compression =item * L - Integration with L =item * L - Help stream files to the browser =item * L - Allows for more of an ASP-style code structure, with the difference that code and HTML for each screen are in separate files. =item * L - Use L as an alternative to HTML::Template. =back Consult each plug-in for the exact usage syntax. =head2 Writing Plug-ins Writing plug-ins is simple. Simply create a new package, and export the methods that you want to become part of a CGI::Application project. See L for an example. In order to avoid namespace conflicts within a CGI::Application object, plugin developers are recommended to use a unique prefix, such as the name of plugin package, when storing information. For instance: $app->{__PARAM} = 'foo'; # BAD! Could conflict. $app->{'MyPlugin::Module::__PARAM'} = 'foo'; # Good. $app->{'MyPlugin::Module'}{__PARAM} = 'foo'; # Good. =head2 Writing Advanced Plug-ins - Using callbacks When writing a plug-in, you may want some action to happen automatically at a particular stage, such as setting up a database connection or initializing a session. By using these 'callback' methods, you can register a subroutine to run at a particular phase, accomplishing this goal. B # register a callback to the standard CGI::Application hooks # one of 'init', 'prerun', 'postrun', 'teardown' or 'load_tmpl' # As a plug-in author, this is probably the only method you need. # Class-based: callback will persist for all runs of the application $class->add_callback('init', \&some_other_method); # Object-based: callback will only last for lifetime of this object $self->add_callback('prerun', \&some_method); # If you want to create a new hook location in your application, # You'll need to know about the following two methods to create # the hook and call it. # Create a new hook $self->new_hook('pretemplate'); # Then later execute all the callbacks registered at this hook $self->call_hook('pretemplate'); B =head3 add_callback() $self->add_callback ('teardown', \&callback); $class->add_callback('teardown', 'method'); The add_callback method allows you to register a callback function that is to be called at the given stage of execution. Valid hooks include 'init', 'prerun', 'postrun' and 'teardown', 'load_tmpl', and any other hooks defined using the C method. The callback should be a reference to a subroutine or the name of a method. If multiple callbacks are added to the same hook, they will all be executed one after the other. The exact order depends on which class installed each callback, as described below under B. Callbacks can either be I or I, depending upon whether you call C as an object method or a class method: # add object-based callback $self->add_callback('teardown', \&callback); # add class-based callbacks $class->add_callback('teardown', \&callback); My::Project->add_callback('teardown', \&callback); Object-based callbacks are stored in your web application's C<$c> object; at the end of the request when the C<$c> object goes out of scope, the callbacks are gone too. Object-based callbacks are useful for one-time tasks that apply only to the current running application. For instance you could install a C callback to trigger a long-running process to execute at the end of the current request, after all the HTML has been sent to the browser. Class-based callbacks survive for the duration of the running Perl process. (In a persistent environment such as C or C, a single Perl process can serve many web requests.) Class-based callbacks are useful for plugins to add features to all web applications. Another feature of class-based callbacks is that your plugin can create hooks and add callbacks at any time - even before the web application's C<$c> object has been initialized. A good place to do this is in your plugin's C subroutine: package CGI::Application::Plugin::MyPlugin; use base 'Exporter'; sub import { my $caller = scalar(caller); $caller->add_callback('init', 'my_setup'); goto &Exporter::import; } Notice that C<< $caller->add_callback >> installs the callback on behalf of the module that contained the line: use CGI::Application::Plugin::MyPlugin; =cut sub add_callback { my ($c_or_class, $hook, $callback) = @_; $hook = lc $hook; die "no callback provided when calling add_callback" unless $callback; die "Unknown hook ($hook)" unless exists $INSTALLED_CALLBACKS{$hook}; if (ref $c_or_class) { # Install in object my $self = $c_or_class; push @{ $self->{__INSTALLED_CALLBACKS}{$hook} }, $callback; } else { # Install in class my $class = $c_or_class; push @{ $INSTALLED_CALLBACKS{$hook}{$class} }, $callback; } } =head3 new_hook(HOOK) $self->new_hook('pretemplate'); The C method can be used to create a new location for developers to register callbacks. It takes one argument, a hook name. The hook location is created if it does not already exist. A true value is always returned. For an example, L adds hooks before and after every template is processed. See C for more details about how hooks are called. =cut sub new_hook { my ($class, $hook) = @_; $INSTALLED_CALLBACKS{$hook} ||= {}; return 1; } =head3 call_hook(HOOK) $self->call_hook('pretemplate', @args); The C method is used to executed the callbacks that have been registered at the given hook. It is used in conjunction with the C method which allows you to create a new hook location. The first argument to C is the hook name. Any remaining arguments are passed to every callback executed at the hook location. So, a stub for a callback at the 'pretemplate' hook would look like this: sub my_hook { my ($c,@args) = @_; # .... } Note that hooks are semi-public locations. Calling a hook means executing callbacks that were registered to that hook by the current object and also those registered by any of the current object's parent classes. See below for the exact ordering. =cut sub call_hook { my $self = shift; my $app_class = ref $self || $self; my $hook = lc shift; my @args = @_; die "Unknown hook ($hook)" unless exists $INSTALLED_CALLBACKS{$hook}; my %executed_callback; # First, run callbacks installed in the object foreach my $callback (@{ $self->{__INSTALLED_CALLBACKS}{$hook} }) { next if $executed_callback{$callback}; eval { $self->$callback(@args); }; $executed_callback{$callback} = 1; die "Error executing object callback in $hook stage: $@" if $@; } # Next, run callbacks installed in class hierarchy # Cache this value as a performance boost $self->{__CALLBACK_CLASSES} ||= [ Class::ISA::self_and_super_path($app_class) ]; # Get list of classes that the current app inherits from foreach my $class (@{ $self->{__CALLBACK_CLASSES} }) { # skip those classes that contain no callbacks next unless exists $INSTALLED_CALLBACKS{$hook}{$class}; # call all of the callbacks in the class foreach my $callback (@{ $INSTALLED_CALLBACKS{$hook}{$class} }) { next if $executed_callback{$callback}; eval { $self->$callback(@args); }; $executed_callback{$callback} = 1; die "Error executing class callback in $hook stage: $@" if $@; } } } =pod B Object-based callbacks are run before class-based callbacks. The order of class-based callbacks is determined by the inheritance tree of the running application. The built-in methods of C, C, C, and C are also executed this way, according to the ordering below. In a persistent environment, there might be a lot of applications in memory at the same time. For instance: CGI::Application Other::Project # uses CGI::Application::Plugin::Baz Other::App # uses CGI::Application::Plugin::Bam My::Project # uses CGI::Application::Plugin::Foo My::App # uses CGI::Application::Plugin::Bar Suppose that each of the above plugins each added a callback to be run at the 'init' stage: Plugin init callback ------ ------------- CGI::Application::Plugin::Baz baz_startup CGI::Application::Plugin::Bam bam_startup CGI::Application::Plugin::Foo foo_startup CGI::Application::Plugin::Bar bar_startup When C runs, only C and C will run. The other callbacks are skipped. The C<@ISA> list of C is: My::App My::Project CGI::Application This order determines the order of callbacks run. When C is run on a C application, callbacks installed by these modules are run in order, resulting in: C, C, and then finally C. If a single class installs more than one callback at the same hook, then these callbacks are run in the order they were registered (FIFO). =cut =head1 COMMUNITY Therese are primary resources available for those who wish to learn more about CGI::Application and discuss it with others. B This is a community built and maintained resource that anyone is welcome to contribute to. It contains a number of articles of its own and links to many other CGI::Application related pages: L B 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 B This project is managed using git and is available on Github: L =head1 SEE ALSO =over 4 =item o L =item o L =item o B - A full-featured web application based on CGI::Application. http://www.cafweb.org/ =back =head1 MORE READING If you're interested in finding out more about CGI::Application, the following articles are available on Perl.com: Using CGI::Application http://www.perl.com/pub/a/2001/06/05/cgi.html Rapid Website Development with CGI::Application http://www.perl.com/pub/a/2006/10/19/cgi_application.html Thanks to O'Reilly for publishing these articles, and for the incredible value they provide to the Perl community! =head1 AUTHOR Jesse Erlbaum Mark Stosberg has served as a co-maintainer since version 3.2, Martin McGrath became a co-maintainer as of version 4.51, with the help of the numerous contributors documented in the Changes file. =head1 CREDITS CGI::Application was originally developed by The Erlbaum Group, a software engineering and consulting firm in New York City. Thanks to Vanguard Media (http://www.vm.com) for funding the initial development of this library and for encouraging Jesse Erlbaum to release it to the world. Many thanks to Sam Tregar (author of the most excellent HTML::Template module!) for his innumerable contributions to this module over the years, and most of all for getting me off my ass to finally get this thing up on CPAN! Many other people have contributed specific suggestions or patches, which are documented in the C file. Thanks also to all the members of the CGI-App mailing list! Your ideas, suggestions, insights (and criticism!) have helped shape this module immeasurably. (To join the mailing list, visit http://lists.openlib.org/mailman/listinfo/cgiapp ) =head1 LICENSE CGI::Application : Framework for building reusable web-applications Copyright (C) 2000-2003 Jesse Erlbaum This module is free software; you can redistribute it and/or modify it under the terms of either: a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" which comes with this module. 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 either the GNU General Public License or the Artistic License for more details. You should have received a copy of the Artistic License with this module, in the file ARTISTIC. If not, I'll be glad to provide one. 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 =cut CGI-Application-4.61/lib/CGI/Application000755001750001750 013246212654 17356 5ustar00martomarto000000000000CGI-Application-4.61/lib/CGI/Application/Mailform.pm000444001750001750 4735613246212654 21656 0ustar00martomarto000000000000 package CGI::Application::Mailform; # Always use strict! use strict; # This is a CGI::Application module use CGI::Application; @CGI::Application::Mailform::ISA = qw/CGI::Application/; # Required, but not enforced by Makefile.PL! use Net::SMTP; use Carp; ############################################# ## OVERRIDE METHODS ## # Run when new() is called sub setup { my $self = shift; $self->mode_param('rm'); $self->start_mode('showform'); # Set up run-mode table. In a typical CGI::Application module, this would # contain multiple run-modes -- one for each think your app can do. # We're using sub-ref instead of name-ref to display more intuitive errors. # $self->run_modes( 'showform' => \&redirect_to_mailform, 'submitform' => \&submitform_and_sendmail, ); } # Called when run() is called. sub cgiapp_prerun { my $self = shift; my $runmode = shift; # Make sure the instance script is correct $self->validate_runtime(); } ############################################# ## RUN-MODE METHODS ## sub redirect_to_mailform { my $self = shift; # Set up the HTTP redirect my $redirect_url = $self->param('HTMLFORM_REDIRECT_URL'); return $self->do_redirect($redirect_url); } sub submitform_and_sendmail { my $self = shift; # Actually send out the email message $self->sendmail(); # Set up the HTTP redirect my $redirect_url = $self->param('SUCCESS_REDIRECT_URL'); return $self->do_redirect($redirect_url); } ############################################# ## PRIVATE METHODS ## # Perform an HTTP redirect sub do_redirect { my $self = shift; my $redirect_url = shift; $self->header_type( 'redirect' ); $self->header_props( -url => $redirect_url ); # Return HTML to the web browser my $redirect_html = "Continue: $redirect_url"; return $redirect_html; } # This method is to verify that the instance script (i.e., "mailform.cgi") # contains the correct configuration parameters. sub validate_runtime { my $self = shift; ## CHECK REQUIRED PARAMETERS # my $req_failed = 0; my @required_params = qw/ MAIL_FROM MAIL_TO HTMLFORM_REDIRECT_URL SUCCESS_REDIRECT_URL FORM_FIELDS /; foreach my $req_param (@required_params) { # Check each req param to verify that it is there unless ( defined($self->param($req_param)) && length($self->param($req_param)) ) { $req_failed++; carp("Required parameter '$req_param' not specified"); } else { # Especially check that FORM_FIELDS is an array-ref if (($req_param eq 'FORM_FIELDS') && (ref($self->param('FORM_FIELDS')) ne 'ARRAY')) { $req_failed++; carp("Required parameter 'FORM_FIELDS' is not an array reference"); } } } # Die if we have an invalid run-time configuration croak("Missing or invalid required parameters") if ($req_failed); ## CHECK OPTIONAL PARAMETERS / SET DEFAULT VALUES # my $opt_failed = 0; ## ENV_FIELDS # If undefined, define as null $self->param('ENV_FIELDS', []) unless (defined($self->param('ENV_FIELDS'))); # Now, check for validity unless (ref($self->param('ENV_FIELDS')) eq 'ARRAY') { $opt_failed++; carp("Parameter 'ENV_FIELDS' is not an array reference"); } ## SUBJECT my $subject = $self->param('SUBJECT'); unless (defined($subject) && length($subject)) { $subject = 'Form submission from ' . ($ENV{HTTP_REFERER} || $ENV{SCRIPT_NAME}); $self->param('SUBJECT', $subject); } ## SMTP_HOST $self->param('SMTP_HOST', '') unless (defined($self->param('SMTP_HOST'))); # Expect a scalar for SMTP_HOST. Other values will be deemed errors, # to prevent problems when interfacing with Net::SMTP. unless (ref($self->param('SMTP_HOST')) eq '') { $opt_failed++; carp("Parameter 'SMTP_HOST' is not a scalar"); } # Die if we have an invalid run-time configuration croak("Invalid optional parameters") if ($opt_failed); } # Establish SMTP connection sub connect_smtp { my $self = shift; my $smtp_host = $self->param('SMTP_HOST'); my $smtp_connection; if (length($smtp_host)) { # Use provided host $smtp_connection = Net::SMTP->new($smtp_host); croak("Unable to connect to '$smtp_host'") unless (defined($smtp_connection)); } else { # Use default host $smtp_connection = Net::SMTP->new(); croak("Unable to establish SMTP connection") unless (defined($smtp_connection)); } return $smtp_connection; } # This method actually generates and sends the email message via # SMTP, or die()s trying. sub sendmail { my $self = shift; # Get the CGI query object my $q = $self->query(); my $mailfrom = $self->param('MAIL_FROM'); my $mailto = $self->param('MAIL_TO'); my $subject = $self->param('SUBJECT'); # Get the message body my $msgbody = $self->build_msgbody(); # Connect to SMTP server my $smtp_connection = $self->connect_smtp(); # Here's where we "do the deed"... $smtp_connection->mail($mailfrom); $smtp_connection->to($mailto); # Enter data mode $smtp_connection->data(); # Send the message content (header + body) $smtp_connection->datasend("From: $mailfrom\n"); $smtp_connection->datasend("To: $mailto\n"); $smtp_connection->datasend("Subject: $subject\n"); $smtp_connection->datasend("\n"); $smtp_connection->datasend($msgbody); $smtp_connection->datasend("\n"); # Exit data mode $smtp_connection->dataend(); # Be polite -- disconnect from the server! $smtp_connection->quit(); } # Here's where the majority of the work gets done. # Based on the settings in the instance script and # the CGI form data, an email message body is created. sub build_msgbody { my $self = shift; # Get the CGI query object my $q = $self->query(); # The longest journey begins with a single step... my $msgbody = ''; ## Populate message body with form data # my $form_fields = $self->param('FORM_FIELDS'); my $ff_count = 1; $msgbody .= "The following data has been submitted:\n\n"; foreach my $field (@$form_fields) { $msgbody .= "$ff_count\. $field\:\n" . $self->clean_data($q->param($field)). "\n\n\n"; $ff_count++; } $msgbody .= "\n"; ## Populate message body with environment data # my $env_fields = $self->param('ENV_FIELDS'); # Do we actually have any env data requested? if (@$env_fields) { my $ef_count = 1; $msgbody .= "Form environment data:\n\n"; foreach my $field (@$env_fields) { $msgbody .= "$ef_count\. $field\:\n" . $self->clean_data($ENV{$field}). "\n\n\n"; $ef_count++; } } # Send back the complete message body return $msgbody; } # This method cleans up data for inclusion into the email message sub clean_data { my $self = shift; my $field_data = shift; # Set undef strings to a null string $field_data = '' unless (defined($field_data)); # Strip leading & trailing white space $field_data =~ s/^\s*//; $field_data =~ s/\s$//; # If we have no answer, put "[n/a]" in there. $field_data = '[n/a]' unless (length($field_data)); return $field_data; } ############################################# ## POD ## =pod =head1 NAME CGI::Application::Mailform - A simple HTML form to email system =head1 SYNOPSIS ## In "mailform.cgi" -- use CGI::Application::Mailform; # Create a new Mailform instance... my $mf = CGI::Application::Mailform->new(); # Configure your mailform $mf->param('MAIL_FROM' => 'webmaster@your.domain'); $mf->param('MAIL_TO' => 'form_recipient@your.domain'); $mf->param('HTMLFORM_REDIRECT_URL' => '/uri/or/url/to/mailform.html'); $mf->param('SUCCESS_REDIRECT_URL' => '/uri/or/url/to/thankyou.html'); $mf->param('FORM_FIELDS' => [qw/name address comments etc/]); # Optional variables $mf->param('SMTP_HOST' => 'mail.your.domain'); $mf->param('SUBJECT' => 'New form submission'); $mf->param('ENV_FIELDS' => [qw/REMOTE_ADDR HTTP_USER_AGENT/]); # Now run... $mf->run(); exit(0); ## In "mailform.html" -- ## In "thankyou.html" --

Thanks for your submission! It has been sent.

=head1 DESCRIPTION CGI::Application::Mailform is a reusable and customizable mailform for the web. It is intentionally simple, and provides very few facilities. What it does do is provide an easy-to-use, secure system for taking the contents of a HTML form submission and sending it, via email, to a specified recipient. This module was created as an example of how to use CGI::Application, a framework for creating reusable web-based applications. In addition to providing a simple example of CGI::Application's usage, CGI::Application::Mailform is also a fully functional application, capable of running in a production environment. Just as is the case with any web-application built upon CGI::Application, CGI::Application::Mailform will run on any web server and operating system which supports the Common Gateway Interface (CGI). It will run equally well on Apache as it runs on IIS or the iPlanet server. It will run perfectly well on UNIX, Linux, Solaris or Windows NT. It will take full advantage of the advanced capabilities of MOD_PERL. It will probably even run under FastCGI (although the author has not personally tested it in that environment). =head2 USAGE Once CGI::Application::Mailform has been installed, you must complete the following steps to create a custom mailform on your website: 1. Create 'mailform.html' 2. Create 'thankyou.html' 3. Create 'mailform.cgi' Examples of these files are provided in the directory "Examples" which can be found in the installation tar file for CGI::Application. =head2 Create 'mailform.html' The file 'mailform.html' is simply an HTML file which contains your web form. This is the form whose contents will be sent, via CGI::Application::Mailform, to the specified recipient's email address. This file need only contain the basic HTML form. There are two requirements for this form. First, the "action" attribute of the
element must refer to the CGI instance script ('mailform.cgi') you are about to create. Second, the form must set a "hidden" form field with the name "rm" and the value "submitform". This hidden parameter is what tells the CGI::Application::Mailform application to send the email message, as opposed to send the user to the HTML form. For example:
Your 'mailform.html' may also contain JavaScript to provide form validation. The CGI::Application::Mailform does not (currently) have any internal form validation capabilities. As described earlier, this is a very simple system. If it is necessary to enforce any fields as "required", it is recommended that JavaScript be used. NOTE: It is not necessary that your HTML file be called 'mailform.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 'HTMLFORM_REDIRECT_URL'. =head2 Create 'thankyou.html' The next file you need to create is your 'thankyou.html' file. This file is the simplest of all. This is the file to which users will be redirected once they have successfully submitted their form data. The purpose of this screen is to inform and assure the user that their form data submission has been successfully received and processed. For example: Thank you!

Thanks for your submission!

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/t000755001750001750 013246212655 14207 5ustar00martomarto000000000000CGI-Application-4.61/t/arrayrefmodes.t000444001750001750 170413246212655 17376 0ustar00martomarto000000000000use 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.t000444001750001750 3251613246212655 15641 0ustar00martomarto000000000000use 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.t000444001750001750 3747613246212654 16510 0ustar00martomarto000000000000 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.t000444001750001750 113013246212654 17700 0ustar00martomarto000000000000use 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.t000444001750001750 121113246212654 17154 0ustar00martomarto000000000000use 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.t000444001750001750 126713246212655 16535 0ustar00martomarto000000000000use 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.t000444001750001750 72113246212655 16356 0ustar00martomarto000000000000use 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.t000444001750001750 304113246212654 17201 0ustar00martomarto000000000000 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.t000444001750001750 174413246212654 17531 0ustar00martomarto000000000000#!/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.t000444001750001750 75313246212654 16323 0ustar00martomarto000000000000use 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.t000444001750001750 57113246212655 21270 0ustar00martomarto000000000000# 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.t000444001750001750 376013246212655 20672 0ustar00martomarto000000000000use 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.t000444001750001750 176313246212654 16251 0ustar00martomarto000000000000use 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.t000444001750001750 340713246212654 16047 0ustar00martomarto000000000000use 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.t000444001750001750 76113246212655 15662 0ustar00martomarto000000000000# 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.t000444001750001750 221413246212654 17040 0ustar00martomarto000000000000 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.t000444001750001750 47613246212655 16036 0ustar00martomarto000000000000use 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/lib000755001750001750 013246212655 14755 5ustar00martomarto000000000000CGI-Application-4.61/t/lib/TestApp.pm000444001750001750 666313246212654 17042 0ustar00martomarto000000000000package 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.pm000444001750001750 61413246212654 17151 0ustar00martomarto000000000000package 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.pm000444001750001750 72613246212654 17156 0ustar00martomarto000000000000package 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.pm000444001750001750 56013246212655 17154 0ustar00martomarto000000000000package 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.pm000444001750001750 202213246212654 17167 0ustar00martomarto000000000000package 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.pm000444001750001750 76113246212655 17161 0ustar00martomarto000000000000package 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.pm000444001750001750 15213246212654 17067 0ustar00martomarto000000000000 package TestApp2; use strict; use TestApp; @TestApp2::ISA = qw(TestApp); # Test sub-inheritance 1; CGI-Application-4.61/t/lib/TestApp3.pm000444001750001750 170213246212655 17113 0ustar00martomarto000000000000 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.pm000444001750001750 106013246212654 17110 0ustar00martomarto000000000000 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.pm000444001750001750 135113246212654 17114 0ustar00martomarto000000000000 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.pm000444001750001750 302613246212654 17116 0ustar00martomarto000000000000 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.pm000444001750001750 67313246212654 17104 0ustar00martomarto000000000000 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.pm000444001750001750 116313246212654 17120 0ustar00martomarto000000000000 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.pm000444001750001750 156013246212655 17123 0ustar00martomarto000000000000package 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.pm000444001750001750 107513246212654 16714 0ustar00martomarto000000000000package 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/templates000755001750001750 013246212654 16752 5ustar00martomarto000000000000CGI-Application-4.61/t/lib/templates/test.tmpl000444001750001750 4213246212654 20720 0ustar00martomarto000000000000----><----