File Coverage

blib/lib/CGI/Framework.pm
Criterion Covered Total %
statement 110 476 23.1
branch 34 220 15.4
condition 22 157 14.0
subroutine 14 43 32.5
pod 20 26 76.9
total 200 922 21.6


line stmt bran cond sub pod time code
1             package CGI::Framework;
2              
3             # $Header: /cvsroot/CGI::Framework/lib/CGI/Framework.pm,v 1.130 2005/10/11 16:21:24 mina Exp $
4              
5 1     1   29792 use strict;
  1         3  
  1         46  
6 1     1   1946 use HTML::Template;
  1         27349  
  1         47  
7 1     1   1249 use CGI::Session qw/-api3/;
  1         8233  
  1         11  
8 1     1   2503 use CGI;
  1         23422  
  1         9  
9 1     1   1229 use CGI::Carp qw(fatalsToBrowser set_message);
  1         3519  
  1         10  
10 1     1   137 use Fcntl ':flock';
  1         2  
  1         170  
11              
12             BEGIN {
13 1     1   6 use Exporter ();
  1         3  
  1         23  
14 1     1   5 use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $LASTINSTANCE);
  1         2  
  1         168  
15 1     1   4 $VERSION = "0.23";
16 1         14 @ISA = qw (Exporter);
17 1         4 @EXPORT = qw ();
18 1         4 @EXPORT_OK = qw (add_error assert_form assert_session clear_session dispatch form get_cgi_object get_cgi_session_object html html_push html_unshift initial_template initialize_cgi_framework log_this remember session show_template return_template);
19 1         857 %EXPORT_TAGS = ('nooop' => [@EXPORT_OK],);
20             }
21              
22             =head1 NAME
23              
24             CGI::Framework - A simple-to-use, lightweight web CGI framework
25              
26             It is primarily a glue between HTML::Template, CGI::Session, CGI, Locale::Maketext and some magic :)
27              
28             =head1 SYNOPSIS
29              
30             use CGI::Framework;
31             use vars qw($f);
32            
33             #
34             # Setup the initial framework instance
35             #
36             $f = new CGI::Framework (
37             sessions_dir => "/tmp",
38             templates_dir => "/home/stuff/myproject/templates",
39             initial_template => "enterusername",
40             )
41             || die "Failed to create a new CGI::Framework instance: $@\n";
42              
43             #
44             # Get the instance to "do it's magic", including handling the verification of the
45             # just-submitting form, preparing the data for the upcoming template to be sent, and any cleanup
46             #
47             $f->dispatch();
48              
49             #
50             # This sub is automatically called after the "enterusername" template is submitted by the client
51             #
52             sub validate_enterusername {
53             my $f = shift;
54             if (!$f->form("username")) {
55             $f->add_error("You must enter a username");
56             }
57             elsif (!$f->form("password")) {
58             $f->add_error("You must enter your password");
59             }
60             else {
61             if ($f->form("username") eq "mina" && $f->form("password") eq "verysecret") {
62             $f->session("username", "mina");
63             $f->session("authenticated", "1");
64             }
65             else {
66             $f->add_error("Authentication failed");
67             }
68             }
69             }
70              
71             #
72             # This sub is automatically called before the "mainmenu" template is sent
73             #
74             sub pre_mainmenu {
75             my $f = shift;
76             $f->assert_session("authenticated");
77             $f->html("somevariable", "somevalue");
78             $f->html("name", $f->session("username"));
79             }
80              
81             #
82             # This sub is automatically called after the "logout" template is sent
83             #
84             sub post_logout {
85             my $f = shift;
86             $f->clear_session();
87             }
88              
89             =head1 DESCRIPTION
90              
91             CGI::Framework is a simple and lightweight framework for building web-based CGI applications. It features complete code-content separation (templating) by utilizing the HTML::Template library, stateful file or database-based sessions by utilizing the CGI::Session library, form parsing by utilizing the CGI library, (optional) multi-lingual templates support, and an extremely easy to use methodology for the validation, pre-preparation and post-cleanup associated with each template. It also provides easy logging mechanisms, graceful fatal error handling, including special templates and emails to admins.
92              
93             =head1 CONCEPTUAL OVERVIEW
94              
95             Before we jump into the technical details, let's skim over the top-level philosophy for a web application:
96              
97             =over 4
98              
99             =item *
100              
101             The client sends an initial GET request to the web server
102              
103             =item *
104              
105             The CGI recognizes that this is a new client, creates a new session, sends the session ID to the client in the form of a cookie, followed by sending a pre-defined initial template
106              
107             =item *
108              
109             The user interacts with the template, filling out any form elements, then re-submits the form back to the CGI
110              
111             =item *
112              
113             The CGI reloads the session based on the client cookie, validates the form elements the client is submitting. If any errors are found, the client is re-sent the previous template along with error messages. If no errors were found, the form values are either acted on, or stored into the session instance for later use. The client is then sent the next template.
114              
115             =item *
116              
117             The flow of templates can either be linear, where there's a straight progression from template 1 to template 2 to template 3 (such as a simple ordering form) or can be non-linear, where the template shown will be based on one of many buttons a client clicks on (such as a main-menu always visible in all the templates)
118              
119             =item *
120              
121             Sessions should automatically expire if not loaded in X amount of time to prevent unauthorized use.
122              
123             =back
124              
125             =head1 IMPLEMENTATION OVERVIEW
126              
127             Implementing this module usually consists of:
128              
129             =over 4
130              
131             =item *
132              
133             Writing the stub code as per the SYNOPSIS. This entails creating a new CGI::Framework instance, then calling the dispatch() method.
134              
135             =item *
136              
137             Creating your templates in the templates_dir supplied earlier. Templates should have the .html extension and can contain any templating variables, loops, and conditions described in the L documentation.
138              
139             =item *
140              
141             For each template created, you can optionally write none, some or all of the needed perl subroutines to interact with it. The possible subroutines that, if existed, will be called automatically by the dispatch() method are:
142              
143             =over 4
144              
145             =item validate_templatename()
146              
147             This sub will be called after a user submits the form from template templatename. In this sub you should use the assert_session() and assert_form() methods to make sure you have a sane environment populated with the variables you're expecting.
148              
149             After that, you should inspect the supplied input from the form in that template. If any errors are found, use the add_error() method to record your objections. If no errors are found, you may use the session() or remember() methods to save the form variables into the session for later utilization.
150              
151             =item pre_templatename()
152              
153             This sub will be called right before the template templatename is sent to the browser. It's job is to call the html() method, giving it any dynamic variables that will be interpolated by L inside the template content.
154              
155             =item post_templatename()
156              
157             This sub will be called right after the template templatename has been sent to the browser and right before the CGI finishes. It's job is to do any clean-up necessary after displaying that template. For example, on a final-logout template, this sub could call the clear_session() method to delete any sensitive information.
158              
159             =back
160              
161             There are also 4 special sub names you can create:
162              
163             =over 4
164              
165             =item pre__pre__all()
166              
167             This sub will be called before any template is sent (and before pre_templatename() is called). It is rarely needed to write or use such a sub.
168              
169             =item post__pre__all()
170              
171             This sub will be called before any template is sent (and after pre_templatename() is called). It is rarely needed to write or use such a sub.
172              
173             =item pre__post__all()
174              
175             This sub will be called after any template is sent (and before post_templatename() is called). It is rarely needed to write or use such a sub.
176              
177             =item post__post__all()
178              
179             This sub will be called after any template is sent (and after post_templatename() is called). It is rarely needed to write or use such a sub.
180              
181             =back
182              
183             If any of the above subroutines are found and called, they will be passed 2 arguments: The CGI::Framework instance itself, and the name of the template about to be/just sent.
184              
185             =back
186              
187             =head1 STARTING A NEW PROJECT
188              
189             If you're impatient, skip to the STARTING A NEW PROJECT FOR THE IMPATIENT section below, however it is recommended you at least skim-over this detailed section, especially if you've never used this module before.
190              
191             The following steps should be taken to start a new project:
192              
193             =over 4
194              
195             =item SETUP DIRECTORY STRUCTURE
196              
197             This is the recommended directory structure for a new project:
198              
199             =over 4
200              
201             =item F
202              
203             This is where your CGI that use()es CGI::Framework will be placed. CGIs placed there will be very simple, initializing a new CGI::Framework instance and calling the dispatch() method. The CGIs should also add F to their 'use libs' path, then require pre_post and validate.
204              
205             =item F
206              
207             This directory will contain 2 important files require()ed by the CGIs, F and F. F should contain all pre_templatename() and post_templatename() routines, while F should contain all validate_templatename() routines. This seperation is not technically necessary, but is recommended. This directory will also possibly contain F which will be a base sub-class of L if you decide to make your errors added via add_error() localized to the use's language (refer to the "INTERNATIONALIZATION AND LOCALIZATION" section). This directory will also hold any custom .pm files you write for your project.
208              
209             =item F
210              
211             This directory will contain all the templates you create. Templates should end in the .html extension to be found by the show_template() or return_template() methods. More on how you should create the actual templates in the CREATE TEMPLATES section
212              
213             =item F
214              
215             If you decide to use file-based sessions storage (the default), this directory will be the holder for all the session files. It's permissions should allow the user that the web server runs as (typically "nobody") to write to it.
216              
217             The other alternative is for you to use MySQL-based sessions storage, in which case you won't need to create this directory, but instead initialize the database. More info about this in the CONSTRUCTOR/INITIALIZER documentation section.
218              
219             =item F
220              
221             This directory should contain any static files that your templates reference, such as images, style sheets, static html links, multimedia content, etc...
222              
223             =back
224              
225             =item CONFIGURE YOUR WEB SERVER
226              
227             How to do this is beyond this document due to the different web servers out there, but in summary, you want to create a new virtual host, alias the document root to the above F directory, alias /cgi-bin/ to the above F directory and make sure the server will execute instead of serve files there, and in theory you're done.
228              
229             =item CREATE TEMPLATES
230              
231             You will need to create a template for each step you want your user to see. Templates are regular HTML pages with the following additions:
232              
233             =over 4
234              
235             =item CGI::Framework required tags
236              
237             The CGI::Framework absolutely requires you insert these tags into the templates. No ands, iffs or butts about it. The framework will NOT work if you do not place these tags in your template:
238              
239             =over 4
240              
241             =item
242              
243             Place this tag right under the tag
244              
245             =item
246              
247             Place this tag wherever you want errors added with the add_error() method to appear
248              
249             =item
250              
251             Place this tag right before the tag
252              
253             =back
254              
255             It is recommended that you utilize HTML::Template's powerful tag to create base templates that are included at the top and bottom of every template (similar to Server-Side Includes, SSIs). This has the benefit of allowing you to change the layout of your entire site by modifying only 2 files, as well as allows you to insert the above 3 required tags into the shared header and footer templates instead of having to put them inside every content template.
256              
257             =item HTML::Template tags
258              
259             All tags mentioned in the documentation of the HTML::Template module may be used in the templates. This allows dynamic variable substitutions, conditionals, loops, and a lot more.
260              
261             To use a variable in the template (IFs, LOOPs, etc..) , it must either:
262              
263             =over 4
264              
265             =item *
266              
267             Have just been added using the html() method, probably in the pre_templatename() routine.
268              
269             =item *
270              
271             Has just been submitted from the previous template
272              
273             =item *
274              
275             Has been added in the past to the session using the session() method.
276              
277             =item *
278              
279             Has been added automatically for you by CGI::Framework. Refer to the "PRE-DEFINED TEMPLATE VARIABLES" section.
280              
281             =back
282              
283             =item CGI::Framework language tags
284              
285             If you supplied a "valid_languages" arrayref to the new() constructor of CGI::Framework, you can use any of the languages in that arrayref as simple HTML tags. Refer to the "INTERNATIONALIZATION AND LOCALIZATION" section.
286              
287             =item The process() javascript function
288              
289             This javascript function will become available to all your templates and will be sent to the client along with the templates. Your templates should call this function whenever the user has clicked on something that indicates they'd like to move on to the next template. For example, if your templates offer a main menu at the top with 7 options, each one of these options should cause a call to this process() javascript function. Every next, previous, logout, etc.. button should cause a call to this function.
290              
291             This javascript function accepts the following parameters:
292              
293             =over 4
294              
295             =item templatename
296              
297             B
298              
299             This first parameter is the name of the template to show. For example, if the user clicked on an option called "show my account info" that should load the accountinfo.html template, the javascript code could look like this:
300              
301             Show my account info
302              
303             or
304              
305            
306              
307             =item item
308              
309             B
310              
311             If this second parameter is supplied to the process() call, it's value will be available back in your perl code as key "_item" through the form() method.
312              
313             This is typically used to distinguish between similar choices. For example, if you're building a GUI that allows the user to change the password of any of their accounts, you could have something similar to this:
314              
315             bob@domain.com
316            
317             mary@domain.com
318            
319             john@domain.com
320              
321             =item skipvalidation
322              
323             B
324              
325             If this third parameter is supplied to the process() call with a true value such as '1', it will cause CGI::Framework to send the requested template without first calling validate_templatename() on the previous template and forcing the correction of errors.
326              
327             =back
328              
329             =back
330              
331             =over 4
332              
333             =item The errors template
334              
335             It is mandatory to create a special template named F. This template will be included in all the served pages, and it's job is to re-iterate over all the errors added with the add_error() method and display them. A simple F template looks like this:
336              
337             =over 4
338              
339             =item F sample:
340              
341            
342             The following ERRORS have occurred:
343            
344            
345             *
346            
347            
348             Please correct below and try again.
349            

350            
351              
352             =back
353              
354             =item The missing info template
355              
356             It is recommended, although not mandatory, to create a special template named F. This template will be shown to the client when an assertion made through the assert_form() or assert_session() methods fail. It's job is to explain to the client that they're probably using a timed-out session or submitting templates out of logical order (possibly a cracking attempt), and invites them to start from the beginning.
357              
358             If this template is not found, the above error will be displayed to the client in a text mode.
359              
360             When this template is called due to a failed assertion by assert_form() or assert_session(), 2 special variables: _missing_info and _missing_info_caller, are available for use in the missinginfo template. Refer to the "PRE-DEFINED TEMPLATE VARIABLES" section for details.
361              
362             =item The fatal error template
363              
364             It is recommended, although not mandatory, to create a special template called F and specify that name as the fatal_error_template constructor key. Usually when a fatal error occurs it will be caught by L and a trace will be shown to the browser. This is often technical and is always an eyesore since it does not match your site design. If you'd like to avoid that and show a professional apologetic message when a fatal error occurs, make use of this fatal error template feature.
365              
366             See the "PRE-DEFINED TEMPLATE VARIABLES" section below for an elaboration on the fatal error template and the special variable _fatal_error that you could use in it.
367              
368             =back
369              
370             =item ASSOCIATE THE CODE WITH THE TEMPLATES
371              
372             For each template you created, you might need to write a pre_templatename() sub, a post_templatename() sub and a validate_templatename() sub as described earlier. None of these subs are mandatory.
373              
374             For clarity and consistency purposes, the pre_templatename() and post_templatename() subs should go into the F file, and the validate_templatename() subs should go into the F file.
375              
376             There are also 4 special sub names. pre__pre__all(), post__pre__all(), pre__post__all() and post__post__all(). If you create these subs, they will be called before pre_templatename(), after pre_templatename(), before post_templatename() and after post_templatename() respectively for all templates.
377              
378             =item WRITE YOUR CGI
379              
380             Copying the SYNOPSIS into a new CGI file in the F directory is usually all that's needed unless you have some advanced requirements such as making sure the user is authenticated first before allowing them access to certain templates.
381              
382             =item TEST, FINE TUNE, ETC . . .
383              
384             Every developer does this part, right :) ?
385              
386             =back
387              
388             =head1 STARTING A NEW PROJECT FOR THE IMPATIENT
389              
390             =over 4
391              
392             =item *
393              
394             Install this module
395              
396             =item *
397              
398             Run: perl -MCGI::Framework -e 'CGI::Framework::INITIALIZENEWPROJECT "F"'
399              
400             =item *
401              
402             cd F
403              
404             Customize the stubs that were created there for you. Refer back to the not-so-impatient section above for clarifications of anything you see there.
405              
406             =back
407              
408             =head1 OBJECT-ORIENTED VS. FUNCTION MODES
409              
410             This module allows you to use an object-oriented or a function-based approach when using it. The only drawback to using the function-based mode is that there's a tiny bit of overhead during startup, and that you can only have one instance of the object active within the interpreter (which is not really a logical problem since that is never a desirable thing. It's strictly a technical limitation).
411              
412             =over 4
413              
414             =item THE OBJECT-ORIENTED WAY
415              
416             As the examples show, this is the object-way of doing things:
417              
418             use CGI::Framework;
419              
420             my $instance = new CGI::Framework (
421             this => that,
422             foo => bar,
423             );
424              
425             $instance->dispatch();
426              
427             sub validate_templatename {
428             my $instance = shift;
429             if (!$instance->form("country")) {
430             $instance->add_error("You must select a country");
431             }
432             else {
433             $instance->remember("country");
434             }
435             }
436              
437             sub pre_templatename {
438             my $instance = shift;
439             $instance->html("country", [qw(CA US BR)]);
440             }
441              
442             =item THE FUNCTION-BASED WAY
443              
444             The function-based way is very similar (and slightly less cumbersome to use due to less typing) than the OO way. The differences are: You have to use the ":nooop" tag in the use() line to signify that you want the methods exported to your namespace, as well as use the initialize_cgi_framework() method to initialize the instance instead of the new() method in OO mode. An example of the function-based way of doing things:
445              
446             use CGI::Framework ':nooop';
447              
448             initialize_cgi_framework (
449             this => that,
450             foo => bar,
451             );
452              
453             dispatch();
454              
455             sub validate_templatename {
456             if (!form("country")) {
457             add_error("You must select a country");
458             }
459             else {
460             remember("country");
461             }
462             }
463              
464             sub pre_templatename {
465             html("country", [qw(CA US BR)]);
466             }
467              
468             =back
469              
470             =head1 THE CONSTRUCTOR / INITIALIZER
471              
472             =over 4
473              
474             =item new(%hash)
475              
476             This is the standard object-oriented constructor. When called, will return a new CGI::Framework instance. It accepts a hash (or a hashref) with the following keys:
477              
478             =over 4
479              
480             =item action
481              
482             B
483              
484             If this key is supplied, it should contain the value to be used in the
HTML element's "action" parameter. If not supplied, it will default to environment variable SCRIPT_NAME
485              
486             =item callbacks_namespace
487              
488             B
489              
490             This key should have a scalar value with the name of the namespace that you will put all the validate_templatename(), pre_templatename(), post_templatename(), pre__pre__all(), post__pre__all(), pre__post__all() and post__post__all() subroutines in. If not supplied, it will default to the caller's namespace. Finally if the caller's namespace cannot be determined, it will default to "main".
491              
492             The main use of this option is to allow you, if you so choose, to place your callbacks subs into any arbitrary namespace you decide on (to avoid pollution of your main namespace for example).
493              
494             =item cookie_domain
495            
496             B
497            
498             The key should have a scalar value with the domain that cookie_name is set to. If not supplied the cookie will not be assigned to a specific domain, essentially making tied to the current hostname.
499              
500             =item cookie_name
501              
502             B
503              
504             This key should have a scalar value with the name of the cookie to use when communicating the session ID to the client. If not supplied, will default to "sessionid_" and a simplified representation of the URL.
505              
506             =item disable_back_button
507              
508             B
509              
510             This key should have a scalar value that's true (such as 1) or false (such as 0). Setting it to true will instruct the framework not to allow the user to use their browser's back button. This is done by setting no-cache pragmas on every page served, setting a past expiry date, as well as detecting submissions from previously-served templates and re-showing the last template sent.
511              
512             This behaviour is often desired in time-sensitive web applications.
513              
514             =item expire
515              
516             B
517              
518             Set this to a value that will be passed to CGI::Session's expire() method. If supplied and contains non-digits (such as "+2h") it will be passed verbatim. If supplied and is digits only, it will be passed as minutes. If not supplied will default to "+15m"
519              
520             =item fatal_error_email
521              
522             B
523              
524             If you would like to receive an email when a fatal error occurs, supply this key with a value of either a scalar email address, or an arrayref of multiple email addresses. You will also need to supply the smtp_host key and/or the sendmail key.
525              
526             =item fatal_error_template
527              
528             B
529              
530             Normally fatal errors (caused by a die() anywhere in the program) are captured by CGI::Carp and sent to the browser along with the web server's error log file. If this key is supplied, it's value should be a template name. That template would then be showed instead of the normal CGI::Carp error message. When the template is called, the special template variable _fatal_error will be set. This will allow you to optionally show or not show it by including it in the template content.
531              
532             =item initial_template
533              
534             B
535              
536             This key should have a scalar value with the name of the first template that will be shown to the client when the dispatch() method is called. It can be changed after initialization with the initial_template() method before the dispatch() method is called.
537              
538             =item import_form
539              
540             B
541              
542             This variable should have a scalar value with the name of a namespace in it. It imports all the values of the just-submitted form into the specified namespace. For example:
543              
544             import_form => "FORM",
545              
546             You can then use form elements like:
547              
548             $error = "Sorry $FORM::firstname, you may not $FORM::action at this time.";
549              
550             It provides a more flexible alternative to using the form() method since it can be interpolated inside double-quoted strings, however costs more memory. I am also unsure about how such a namespace would be handled under mod_perl and if it'll remain persistent or not, possibly causing "variable-bleeding" problems across sessions.
551              
552             =item log_filename
553              
554             B
555              
556             This variable should have a scalar value with a fully-qualified filename in it. It will be used by the log_this() method as the filename to log messages to. If supplied, make sure that it is writeable by the user your web server software runs as.
557              
558             =item maketext_class_name
559              
560             B
561              
562             If you wish to localize errors you add via the add_error() method, this key should contain the name of the class you created as the L localization class, such as for example "MyProject::L10N" or "MyProjectLocalization". Refer to the "INTERNATIONALIZATION AND LOCALIZATION" section. You must also set the "valid_languages" key if you wish to set this key.
563              
564             =item output_filter
565              
566             B
567              
568             If you would like to do any manual hacking to the content just before it's sent to the browser, this key should contain the name of a sub (or a reference to a sub) that you'd like to have the framework call. The sub will be passed 2 argumets: The CGI::Framework instance itself, and a reference to a scalar containing the content about to be sent.
569              
570             =item sendmail
571              
572             B
573              
574             If you supplied the fatal_error_email key, you must also supply this key and/or the smtp_host key. If you'd like to deliver the mail using sendmail, supply this key with a value of the fully qualified path to your sendmail binary.
575              
576             =item sessions_dir
577              
578             B
579              
580             This key should have a scalar value holding a directory name where the session files will be stored. If not supplied, a suitable temporary directory will be picked from the system.
581              
582             Note: You may not supply this if you supply the sessions_mysql_dbh key.
583              
584             =item sessions_mysql_dbh
585              
586             B
587              
588             This key should have a value that's a MySQL DBH (DataBase Handle) instance created with the DBI and DBD::Mysql modules. If supplied then the session data will be stored in the mysql table instead of text files. For more information on how to prepare the database, refer to the L documentation.
589              
590             Note: You may not supply this if you supply the sessions_dir key.
591              
592             =item sessions_serializer_default
593              
594             B
595              
596             This key should be set to true if you wish to use the default serialization method for your sessions. This requires the perl module Data::Dumper. For more information refer to the L documentation.
597              
598             Note: You may not supply this if you supply the sessions_serializer_storable or sessions_serializer_freezethaw keys.
599              
600             =item sessions_serializer_freezethaw
601              
602             B
603              
604             This key should be set to true if you wish to use the FreezeThaw serialization method for your sessions. This requires the perl module FreezeThaw. For more information refer to the L documentation.
605              
606             Note: You may not supply this if you supply the sessions_serializer_default or sessions_serializer_storable keys.
607              
608             =item sessions_serializer_storable
609              
610             B
611              
612             This key should be set to true if you wish to use the Storable serialization method for your sessions. This requires the perl module Storable. For more information refer to the L documentation.
613              
614             Note: You may not supply this if you supply the sessions_serializer_default or sessions_serializer_freezethaw keys.
615              
616             =item smtp_from
617              
618             B
619              
620             If your mail server supplied in smtp_host is picky about the "from" address it accepts emails from, set this key to a scalar email address value. If not set, the email address 'cgiframework@localhost' will be set as the from-address.
621              
622             =item smtp_host
623              
624             B
625              
626             If you supplied the fatal_error_email key, you must also supply this key and/or the sendmail key. If you'd like to deliver the mail using direct SMTP transactions (and have Net::SMTP installed), supply this key with a value of the hostname of the mailserver to connect to.
627              
628             If your mailserver is picky about the "from" address it accepts mail from, you should also supply the smtp_from key when using this key, otherwise 'cgiframework@localhost' will be supplied as the from address.
629              
630             =item templates_dir
631              
632             B
633              
634             This key should have a scalar value holding a directory name which contains all the template files. If not supplied, it will be guessed based on the local directory.
635              
636             =item valid_languages
637              
638             B
639              
640             This key should have an arrayref value. The array should contain all the possible language tags you've used in the templates. Refer to the "INTERNATIONALIZATION AND LOCALIZATION" section. You must set this key if you wish to also set the "maketext_class_name" key.
641              
642             =back
643              
644             =item initialize_cgi_framework(%hash)
645              
646             Just like the above new() constructor, except used in the function-based approach instead of the object-oriented approach.
647              
648             =back
649              
650             =head1 METHODS / FUNCTIONS
651              
652             =over 4
653              
654             =item add_error($scalar [, @array ] )
655              
656             This method accepts a scalar error and adds it to the list of errors that will be shown to the client. It should only be called from a validate_templatename() subroutine for each error found during validating the form. This will cause the dispatch() method to re-display the previous template along with all the errors added.
657              
658             If you specified the "valid_languages" and the "maketext_class_name" keys to the initializer, the error message you give to this method will be localized to the user's preferred language (or the default language) before being showed to the user. Refer to the "INTERNATIONALIZATION AND LOCALIZATION" section. If this is the case, you may specify extra arguments after the main $scalar, and they will be passed verbatim to L's maketext() method - this is often used to localize variables within a sentence.
659              
660             =item assert_form(@array)
661              
662             This method accepts an array of scalar values. Each element will be checked to make sure that it has been submitted in the just-submitted form and has a true value. If any elements aren't found or have a false value, the missinginfo template is shown to the client. The missinginfo template will be passed special variables _missing_info and _missing_info_caller which you can use to display details about the failed assertions. Refer to the "PRE-DEFINED TEMPLATE VARIABLES" section for more info.
663              
664             =item assert_session(@array)
665              
666             Just like the assert_form() method, except it checks the values against the session instead of the submitted form.
667              
668             =item clear_session
669              
670             This method deletes all the previously-stored values using the session() or remember() methods.
671              
672             =item dispatch
673              
674             This method is the central dispatcher. It calls validate_templatename on the just-submitted template, checks to see if any errors were added with the add_error() method. If any errors were added, re-sends the client the previous template, otherwise sends the client the template they requested.
675              
676             =item finalize
677              
678             This method undefs some internal references that prevent the object from being destroyed. It's called automatically for you when show_template() is done or if there's a fatal error, so there is usually no need to call it manually.
679              
680             This method exit()s when done - it does not return.
681              
682             =item form($scalar)
683              
684             This method accepts an optional scalar as it's first argument, and returns the value associated with that key from the just-submitted form from the client. If no scalar is supplied, returns all entries from the just-submitted form.
685              
686             =item get_cgi_object
687              
688             Returns the underlying CGI object. To be used if you'd like to do anything fancy this module doesn't provide methods for, such as processing extra cookies, etc...
689              
690             =item get_cgi_session_object
691              
692             Returns the underlying CGI::Session object. To be used if you'd like to do anything fancy this module doesn't provide methods for.
693              
694             =item html($scalar, $scalar)
695              
696             This method accepts a scalar key as it's first argument and a scalar value as it's second. It associates the key with the value in the upcoming template. This method is typically called inside a pre_template() subroutine to prepare some dynamic variables/loops/etc in the templatename template.
697              
698             =item html_push($scalar, $scalar)
699              
700             Very similar to the above html() method, except it treats the key's value as an arrayref (creates it as an arrayref if it didn't exist), and push()es the value into that array. This method is typically used to append to a key that will be used in a template loop with HTML::Template's tag, the value in which case is normally a hashref.
701              
702             =item html_unshift($scalar, $scalar)
703              
704             Very similar to the above html_push() method, except it unshift()s instead of push()es the value.
705              
706             =item log_this($scalar)
707              
708             This method accepts a scalar message and logs it to the filename specified in the log_filename parameter in the new constructor. You can not use this method if you have not supplied a log_filename setting to the constructor.
709              
710             =item remember($scalar [, $scalar])
711              
712             This method accepts a mandatory scalar source key name as it's first argument and an optional scalar destination key name as it's second argument . It then treats that source scalar as a key in the just-submitted form, and saves that key-value pair into the session. This method is simply shorthand for saying:
713              
714             $instance->session($sourcekeyname, $instance->form($sourcekeyname));
715              
716             If the second optional parameter is supplied, then that destination key is used in the session. This allows the key saved in the session to have a different name than the one submitted in the form. In that case, this method becomes a shorthand for:
717              
718             $instance->session($destinationekeyname, $instance->form($sourcekeyname));
719              
720             It is frequently used to premanently save a submitted form key+value inside the validate_templatename() sub after it has been checked for correctness.
721              
722             =item return_template($scalar)
723              
724             This method accepts a scalar template name, and returns the content parsed from that template suitable for sending to the client. Internally it takes care of language substitution, and the , tags.
725              
726             In scalar context it returns the content suitable for sending to the client. In array context it returns the content and the content-type.
727              
728             =item session($scalar [, $scalar])
729              
730             This method accepts a scalar key as it's first argument and an optional scalar value as it's second. If a value is supplied, it saves the key+value pair into the session for future retrieval. If no value is supplied, it returns the previously-saved value associated with the given key.
731              
732             =item show_template($scalar [, $nofinalize])
733              
734             This method accepts a scalar template name, calls the pre__pre__all() sub if found, calls the pre_templatename() sub if found, calls the post__pre__all() sub if found, sends the template to the client, calls the pre__post__all() sub if found, calls the post_templatename() sub if found, calls the post__post__all() sub if found, then exits. Internally uses the return_template() method to calculate actual content to send.
735              
736             Note: This method calls finalize() when done unless $nofinalize is set to true. You probably never want to do this, in which case the call to finalize() will cause this method to never return.
737              
738             =back
739              
740             =head1 PRE-DEFINED TEMPLATE VARIABLES
741              
742             Aside from variables added through the html() method, the submitted form and the current session, these pre-defined variables will be automatically set for you to use in your templates:
743              
744             =over 4
745              
746             =item _current_template
747              
748             This variable will contain the name of the current template
749              
750             =item _fatal_error
751              
752             This variable will contain the error message that caused a fatal error. It will only be available when a fatal error occurs and the fatal error template specified by the fatal_error_template constructor argument is being shown.
753              
754             =item _form_action
755              
756             This variable will contain the URL to the current CGI
757              
758             =item _missing_info
759              
760             This variable will only be available when the missinginfo template is being called from a call to assert_form() or assert_session() methods. It's value will be an arrayref of hashes. Each hash will have a key named "name", the value of which is the name of a key supplied to assert_form() or assert_session() that failed the assertion. This variable can be used with L's TMPL_LOOP macro to display the variables that failed the assertion.
761              
762             =item _missing_info_caller
763              
764             This variable will only be available when the missinginfo template is being called from a call to assert_form() or assert_session() methods. It's value will be a scalar describing the caller of assert_form() or assert_method().
765              
766             =back
767              
768             =head1 INTERNATIONALIZATION (i18n) AND LOCALIZATION (l10n)
769              
770             One of this module's strengths is simplifying support for multi-(human)languages. When the user is presented lingual pieces using this module, it has usually originated from either:
771              
772             =over 4
773              
774             =item *
775              
776             Content inside one of the templates
777              
778             =item *
779              
780             Errors added via the add_error() method
781              
782             =back
783              
784             Multi-language support is initiated by you by supplying the "valid_languages" arrayref to the CGI::Framework constructor. This arrayref should contain a list of language tags you wish to support in your application. These tags are not necessarily the exact same tags as the ISO-specified official language tag, and as a matter of fact it is recommended that you use tags that are as short as possible for reasons that will be apparent below.
785              
786             As an example, if you intend to support English and French in your application, supplying this to the constructor would indicate that:
787              
788             "valid_languages" => ['en', 'fr'],
789              
790             When the module sends output to the user, it will try to send the "appropriate" language localization.
791              
792             B
793              
794             The module uses a fairly simple logic to determine which is the language localization to send:
795              
796             =over 4
797              
798             =item The session variable "_lang"
799              
800             If the session variable "_lang" is set, it will be used as the user's desired localization.
801              
802             You can either populate this variable manually in your code, such as by:
803              
804             session("_lang", "en");
805              
806             Or more conveniently, let CGI::Framework handle that job for you by having the templates set a form element named "_lang". This allows you to add to a top-header template a "Switch to English" button that sets the form element "_lang" to "en", and a "Switch to French" button that sets the form element "_lang" to "fr".
807              
808             When CGI::Framework is processing the submitted form and notices that the form element "_lang" is set, it will update the session's "_lang" correspondingly, hence setting that user's language.
809              
810             =item The default language
811              
812             If the session variable "_lang" is not set as described above, the default language that will be used is the first language tag listed in the "valid_languages" arrayref.
813              
814             =back
815              
816             Finally, this is how to actually define your multi-lingual content:
817              
818             =over 4
819              
820             =item Localizing content inside the templates
821              
822             This is where pleasantness begins. The language tags you defined in the "valid_languages" constructor key can be used as HTML tags inside the templates! CGI::Framework will take care of parsing and presenting the correct language and illiminating the others. An example in a bilingual template:
823              
824             Good morning!
825             Bonjour!
826              
827             =item Localizing errors added via the add_error() method
828              
829             By default, errors you add via the add_error() method will not be localized and will be passed straight-through to the errors template and shown as-is to the end user.
830              
831             To enable localization for the errors, you will need to, aside from supplying the "valid_languages" key, also supply the "maketext_class_name" key to the constructor. This should be the name of a class that you created. CGI::Framework will take care of use()ing that class. For example:
832              
833             "maketext_class_name" => "MyProjectLocalization",
834              
835             Exactly what should be in that class ? This is where I direct you to read L. This class is your project's base localization class. For the impatient, skip down in L's POD to the "HOW TO USE MAKETEXT" section. Follow it step by step except the part about replacing all your print() statements with print maketext() - this is irrelevant in our scenario.
836              
837             After you do the above, your calls to the add_error() method will be automatically localized, using L and your custom localization class. In our example here, you would end up with:
838              
839             =over 4
840              
841             =item *
842              
843             A file in your F folder named F
844              
845             =item *
846              
847             Inside that file, you should have created the following packages:
848              
849             =over 4
850              
851             =item *
852              
853             package MyProjectLocalization;
854              
855             =item *
856              
857             package MyProjectLocalization::en;
858              
859             =item *
860              
861             package MyProjectLocalization::fr;
862              
863             =back
864              
865             =back
866              
867             =back
868              
869             =head1 BUGS
870              
871             I do not (knowingly) release buggy software. If this is the latest release, it's probably bug-free as far as I know. If you do find a problem, please contact me and let me know.
872              
873             =head1 AUTHOR
874              
875             Mina Naguib
876             CPAN ID: MNAGUIB
877             mnaguib@cpan.org
878             http://mina.naguib.ca
879              
880             =head1 COPYRIGHT
881              
882             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
883              
884             The full text of the license can be found in the LICENSE file included with this module.
885              
886             Copyright (C) 2003-2005 Mina Naguib.
887              
888              
889             =head1 SEE ALSO
890              
891             L, L, L, L, L, L.
892              
893             =cut
894              
895             #
896             # Takes a scalar
897             # Adds it to the errors que
898             #
899             sub add_error {
900 0     0 1 0 my $self = _getself(\@_);
901 0   0     0 my $error = shift || croak "Error not supplied";
902 0         0 my @parameters = @_;
903 0   0     0 my $existing_errors = $self->{_html}->{_errors} || [];
904 0         0 $error = $self->localize($error, @parameters);
905 0         0 push(@$existing_errors, { error => $error, });
906 0         0 $self->{_html}->{_errors} = $existing_errors;
907 0         0 return 1;
908             }
909              
910             #
911             # This sub asserts that the key(s) supplied to it exists in the submitted form
912             # If the value is not true, it calls show_template with "missinginfo"
913             # It's mostly used by the subs in pre_post* to validate that the values they need exist
914             #
915             sub assert_form {
916 0     0 1 0 my $self = _getself(\@_);
917 0         0 my @failed = grep { !$self->form($_) } @_;
  0         0  
918 0 0       0 if (@failed) {
919 0         0 foreach (@failed) {
920 0         0 $self->html_push("_missing_info", { "name" => $_, });
921             }
922 0         0 $self->html("_missing_info_caller", join(" -- ", caller));
923 0         0 $self->_missinginfo();
924             }
925             else {
926 0         0 return 1;
927             }
928             }
929              
930             #
931             # This sub asserts that the key(s) supplied to it exists in the session
932             # If the value is not true, it calls show_template with "missinginfo"
933             # It's mostly used by the subs in pre_post* to validate that the values they need exist
934             #
935             sub assert_session {
936 0     0 1 0 my $self = _getself(\@_);
937 0         0 my @failed = grep { !$self->session($_) } @_;
  0         0  
938 0 0       0 if (@failed) {
939 0         0 foreach (@failed) {
940 0         0 $self->html_push("_missing_info", { "name" => $_, });
941             }
942 0         0 $self->html("_missing_info_caller", join(" -- ", caller));
943 0         0 $self->_missinginfo();
944             }
945             else {
946 0         0 return 1;
947             }
948             }
949              
950             #
951             # Clears the session
952             #
953             sub clear_session {
954 0     0 1 0 my $self = _getself(\@_);
955 0         0 my %preserve = (
956             "_lastsent" => "",
957             "_lang" => "",
958             );
959              
960             #
961             # Save preserve-able values
962             #
963 0         0 foreach (keys %preserve) {
964 0         0 $preserve{$_} = $self->session($_);
965             }
966              
967             #
968             # Delete all values
969             #
970 0         0 $self->{_session}->clear();
971              
972             #
973             # Restore preserved values
974             #
975 0         0 foreach (keys %preserve) {
976 0         0 $self->session($_, $preserve{$_});
977             }
978              
979 0         0 return 1;
980             }
981              
982             #
983             # This sub takes care of calling any validate_XYZ methods, displaying old page or requested page
984             # based on whether there were errors or not
985             #
986             sub dispatch {
987 0     0 1 0 my $self = _getself(\@_);
988 0         0 my $validate_template;
989              
990 1     1   6 no strict 'refs';
  1         2  
  1         353  
991              
992             #
993             # Validate the data entered:
994             #
995 0 0       0 if ($self->form("_sv")) {
996              
997             #We skip validation as per requested
998             }
999             else {
1000 0 0 0     0 if ($self->form("_template") && !$self->session("_lastsent")) {
1001              
1002             #
1003             # They are submitting a page but we don't have a lastsent template in session - they probably timed out
1004             #
1005 0         0 $self->_missinginfo();
1006             }
1007              
1008 0 0 0     0 if ($self->{disable_back_button} && $self->session("_lastsent")) {
    0          
1009              
1010             #
1011             # If disable_back_button is set, we always validate last template we sent them
1012             #
1013 0         0 $validate_template = $self->session("_lastsent");
1014             }
1015             elsif ($self->form("_template")) {
1016              
1017             #
1018             # Otherwise we validate the template they're submitting
1019             #
1020 0         0 $validate_template = $self->form("_template");
1021             }
1022              
1023             #
1024             # We implement validation if possible
1025             #
1026 0 0 0     0 if ($validate_template && defined &{"$self->{callbacks_namespace}::validate_$validate_template"}) {
  0         0  
1027 0         0 &{"$self->{callbacks_namespace}::validate_$validate_template"}($self);
  0         0  
1028 0 0       0 if ($self->{_html}->{_errors}) {
1029              
1030             #
1031             # The validation didn't go so well and errors were recorded
1032             # so we re-show the template the failed validation
1033             #
1034 0         0 $self->show_template($validate_template);
1035             }
1036             }
1037             }
1038              
1039             #
1040             # If we reached here, we're all good and present the action they requested
1041             #
1042 0   0     0 $self->show_template($self->form("_action") || $self->{initial_template});
1043              
1044             # Should not reach here
1045 0         0 die "Something's wrong. You should not be seeing this.\n";
1046             }
1047              
1048             #
1049             # Cleans up internal references to allow for destruction THEN EXITS
1050             #
1051             sub finalize {
1052 0     0 1 0 undef $LASTINSTANCE;
1053 0         0 set_message(undef);
1054 0         0 exit;
1055             }
1056              
1057             #
1058             # Takes a scalar key
1059             # Returns the value for that key from the just-submitted form
1060             #
1061             sub form {
1062 0     0 1 0 my $self = _getself(\@_);
1063 0         0 my $key = shift;
1064 0         0 my $value;
1065              
1066 1     1   6 no strict 'refs';
  1         2  
  1         9373  
1067              
1068 0 0       0 if (length($key)) {
1069 0 0       0 return $self->{_import_form} ? ${ $self->{_import_form} . '::' . $key } : $self->{_cgi}->param($key);
  0         0  
1070             }
1071             else {
1072 0         0 return $self->{_cgi}->param();
1073             }
1074             }
1075              
1076             #
1077             # Returns the CGI object
1078             #
1079             sub get_cgi_object {
1080 0     0 1 0 my $self = _getself(\@_);
1081 0         0 return $self->{_cgi};
1082             }
1083              
1084             #
1085             # Returns the CGI::Session object
1086             #
1087             sub get_cgi_session_object {
1088 0     0 1 0 my $self = _getself(\@_);
1089 0         0 return $self->{_session};
1090             }
1091              
1092             #
1093             # Takes a scalar key and a scalar value
1094             # Adds them to the html que
1095             #
1096             sub html {
1097 0     0 1 0 my $self = _getself(\@_);
1098 0   0     0 my $key = shift || croak "key not supplied";
1099 0         0 my $value = shift;
1100 0         0 $self->{_html}->{$key} = $value;
1101 0         0 return 1;
1102             }
1103              
1104             #
1105             # Takes a scalar key and a scalar value
1106             # Pushes the value into the html element as an array
1107             #
1108             sub html_push {
1109 0     0 1 0 my $self = _getself(\@_);
1110 0   0     0 my $key = shift || croak "key not supplied";
1111 0         0 my $value = shift;
1112 0   0     0 my $existing_value = $self->{_html}->{$key} || [];
1113 0 0       0 if (ref($existing_value) ne "ARRAY") {
1114 0         0 croak "Key $key already exists as non-array. Cannot push into it.";
1115             }
1116 0         0 push(@{$existing_value}, $value);
  0         0  
1117 0         0 $self->{_html}->{$key} = $existing_value;
1118 0         0 return 1;
1119             }
1120              
1121             #
1122             # Takes a scalar key and a scalar value
1123             # Unshifts the value into the html element as an array
1124             #
1125             sub html_unshift {
1126 0     0 1 0 my $self = _getself(\@_);
1127 0   0     0 my $key = shift || croak "key not supplied";
1128 0         0 my $value = shift;
1129 0   0     0 my $existing_value = $self->{_html}->{$key} || [];
1130 0 0       0 if (ref($existing_value) ne "ARRAY") {
1131 0         0 croak "Key $key already exists as non-array. Cannot unshift into it.";
1132             }
1133 0         0 unshift(@{$existing_value}, $value);
  0         0  
1134 0         0 $self->{_html}->{$key} = $existing_value;
1135 0         0 return 1;
1136             }
1137              
1138             #
1139             # Re-sets initial_template
1140             #
1141             sub initial_template {
1142 0     0 1 0 my $self = _getself(\@_);
1143 0   0     0 my $initial_template = shift || croak "initial template not supplied";
1144 0         0 $self->{initial_template} = $initial_template;
1145             }
1146              
1147             #
1148             # An alias to new(), to be used in nooop mode
1149             #
1150             sub initialize_cgi_framework {
1151 0 0   0 1 0 my %para = ref($_[0]) eq "HASH" ? %{ $_[0] } : @_;
  0         0  
1152 0   0     0 $para{callbacks_namespace} ||= (caller)[0] || "main";
      0        
1153 0         0 return new("CGI::Framework", \%para);
1154             }
1155              
1156             #
1157             # The constructor. Initializes pretty much everything, returns a new bless()ed instance
1158             #
1159             sub new {
1160 1   50 1 1 547 my $class = shift || "CGI::Framework";
1161 1 50       8 my %para = ref($_[0]) eq "HASH" ? %{ $_[0] } : @_;
  0         0  
1162 1         2 my $self = {};
1163 1         3 my $cookie_value;
1164             my $temp;
1165 0         0 my $expire;
1166 0         0 my $sessions_driver;
1167 0         0 my $sessions_serializer;
1168 1         4 local (*FH);
1169              
1170 1   33     9 $self = bless($self, ref($class) || $class);
1171              
1172             #
1173             # Paranoia: It should be clear anyways... but
1174             #
1175 1 50       4 if ($LASTINSTANCE) {
1176 0         0 $LASTINSTANCE->finalize();
1177             }
1178              
1179             #
1180             # Backwards compatability support
1181             #
1182 1         3 foreach (qw(callbacks_namespace cookie_name import_form initial_template sessions_dir templates_dir valid_languages)) {
1183 7         9 $temp = $_;
1184 7         20 $temp =~ s/_//g;
1185 7 100 66     37 if (!exists $para{$_} && exists $para{$temp}) {
1186 2         7 $para{$_} = $para{$temp};
1187 2         6 delete $para{$temp};
1188             }
1189             }
1190              
1191             #
1192             # Custom fatal error handling
1193             #
1194 1 0 33     6 $para{fatal_error_email} && !$para{smtp_host} && !$para{sendmail} && croak "You must supply smtp_host and/or sendmail when supplying fatal_error_email";
      33        
1195 1 50 33     11 if ($para{"fatal_error_template"} || $para{"fatal_error_email"}) {
1196             set_message(
1197             sub {
1198 0     0   0 my $error = shift;
1199 0         0 my $emailsent = 0;
1200 0         0 my $errorsent = 0;
1201 0         0 my $index;
1202             my @callerparts;
1203 0         0 my @stack;
1204 0         0 local (*SMH);
1205              
1206             #
1207             # Hold your horses - some errors should just be ignored
1208             #
1209 0 0 0     0 if (exists $ENV{"HTTPS"} && $ENV{"HTTPS"} && $error =~ /^((103:)?Software caused connection abort)|((104:)?Connection reset by peer)/i) {
      0        
1210              
1211             #
1212             # This is generated by some braindead web browsers that do not properly terminate an SSL session
1213             #
1214 0         0 $self->finalize();
1215 0         0 return ();
1216             }
1217              
1218             #
1219             # Append stack to error message:
1220             #
1221 0         0 for ($index = 0 ; @callerparts = caller($index) ; $index++) {
1222 0         0 push(@stack, "$callerparts[1]:$callerparts[2] ($callerparts[3])");
1223             }
1224 0         0 @stack = reverse @stack;
1225 0         0 $error .= "\n\nStack trace appended by CGI::Framework fatal error handler:\n";
1226 0         0 foreach (0 .. $#stack) {
1227 0         0 $error .= " " x ($_ + 1);
1228 0         0 $error .= $stack[$_];
1229 0         0 $error .= "\n";
1230             }
1231              
1232             #
1233             # Show something back to the web user regarding the error
1234             # We do this first BEFORE sending off emails because under mod_perl, an open() to a pipe (sendmail) sends some
1235             # crap to the browser - FIXME - NEEDS INVESTIGATING
1236             #
1237 0 0       0 if ($para{"fatal_error_template"}) {
1238 0         0 eval {
1239 0         0 $self->{_html}->{_fatal_error} = $error;
1240 0         0 $self->show_template($para{"fatal_error_template"}, 1);
1241             };
1242 0 0 0     0 if (!$@) {
    0          
1243 0         0 $errorsent = 1;
1244             }
1245             elsif ($@ =~ /mod_?perl/i && $@ =~ /exit/i) {
1246              
1247             #
1248             # Under mod_perl, an exit() (deep in finalize()) called inside an eval (above) gets thrown and therefore caught above
1249             # so we treat it as success
1250             #
1251 0         0 $errorsent = 1;
1252             }
1253             }
1254 0 0       0 if (!$errorsent) {
1255 0         0 print "Content-type: text/html\n\n

The following fatal error occurred:

$error
\n";
1256             }
1257              
1258             #
1259             # Now try to send the fatal error email
1260             #
1261 0 0 0     0 if (!$emailsent && $para{"fatal_error_email"} && $para{"sendmail"}) {
      0        
1262 0         0 eval {
1263 0 0       0 open(SMH, "| $para{sendmail} -t -i") || die "Failed to open pipe to sendmail: $!\n";
1264 0   0     0 print SMH "From: " . ($para{"smtp_from"} || 'cgiframework@localhost') . "\n";
1265 0 0       0 print SMH "To: ", (ref($para{"fatal_error_email"}) eq "ARRAY" ? join(",", @{ $para{"fatal_error_email"} }) : $para{"fatal_error_email"}), "\n";
  0         0  
1266 0         0 print SMH "Subject: Fatal Error\n";
1267 0         0 print SMH "X-CGI-Framework-Method: sendmail $para{sendmail}\n";
1268 0         0 print SMH "X-CGI-Framework-REMOTE-ADDR: $ENV{REMOTE_ADDR}\n";
1269 0         0 print SMH "X-CGI-Framework-PID: $$\n";
1270 0         0 print SMH "\n";
1271 0         0 print SMH "The following fatal error occurred:\n\n$error\n";
1272 0         0 close(SMH);
1273             };
1274 0 0       0 $emailsent = 1 if !$@;
1275             }
1276 0 0 0     0 if (!$emailsent && $para{"fatal_error_email"} && $para{"smtp_host"}) {
      0        
1277 0         0 eval {
1278 0         0 require Net::SMTP;
1279 0   0     0 my $smtp = Net::SMTP->new($para{"smtp_host"}) || die "Could not create Net::SMTP object: $@\n";
1280 0 0 0     0 $smtp->mail($para{"smtp_from"} || 'cgiframework@localhost') || die "Could not send MAIL command: $@\n";
1281 0 0       0 $smtp->recipient(ref($para{"fatal_error_email"}) eq "ARRAY" ? @{ $para{"fatal_error_email"} } : $para{"fatal_error_email"}) || die "Could not send RECIPIENT command: $@\n";
  0 0       0  
1282 0 0       0 $smtp->data("X-CGI-Framework-Method: Net::SMTP $para{smtp_host}\nX-CGI-Framework-REMOTE-ADDR: $ENV{REMOTE_ADDR}\nX-CGI-Framework-PID: $$\n\nThe following fatal error occurred:\n\n$error") || die "Could not send DATA command: $@\n";
1283 0         0 $smtp->quit();
1284             };
1285 0 0       0 $emailsent = 1 if !$@;
1286             }
1287              
1288             #
1289             # Finally cleanup cruft:
1290             #
1291 0         0 $self->finalize();
1292             }
1293 0         0 );
1294             }
1295              
1296             #
1297             # Some initial setup
1298             #
1299 1         4 $para{_html} = {};
1300              
1301             #
1302             # We set some defaults if unsupplied
1303             #
1304 1   50     6 $para{valid_languages} ||= [];
1305 1   50     10 $para{callbacks_namespace} ||= (caller)[0] || "main";
      33        
1306 1 50       4 if (!$para{cookie_name}) {
1307 1         6 $para{cookie_name} = "sessionid_$ENV{SCRIPT_NAME}";
1308 1         5 $para{cookie_name} =~ s/[^0-9a-z]//gi;
1309             }
1310 1 50 33     7 if (!$para{sessions_mysql_dbh} && !$para{sessions_dir}) {
1311              
1312             #
1313             # They didn't supply any sessions stuff, so let's take a guess at some directories for file-based storage:
1314             #
1315 1         4 foreach (qw(/tmp /var/tmp c:/tmp c:/temp c:/windows/temp)) {
1316 1 50       31 if (-d $_) {
1317 1         3 $para{sessions_dir} = $_;
1318 1         17 last;
1319             }
1320             }
1321             }
1322 1 50       9 if (!$para{templates_dir}) {
1323 0         0 foreach (qw(./templates ../templates)) {
1324 0 0       0 if (-d $_) {
1325 0         0 $para{templates_dir} = $_;
1326 0         0 last;
1327             }
1328             }
1329             }
1330 1 50 33     13 if (!$para{sessions_serializer_default} && !$para{sessions_serializer_storable} && !$para{sessions_serializer_freezethaw}) {
      33        
1331 1         30 $para{sessions_serializer_default} = 1;
1332             }
1333              
1334             #
1335             # Now we do sanity checking
1336             #
1337 1 50       6 ref $para{valid_languages} eq "ARRAY" || croak "valid_languages must be an array ref";
1338 1 50       4 if ($para{"maketext_class_name"}) {
1339 0 0       0 @{ $para{valid_languages} } || croak "valid_languages must be set to at least one language to specify the maketext_class_name key";
  0         0  
1340             }
1341 1 50 33     10 $para{sessions_dir} && $para{sessions_mysql_dbh} && croak "Only one of sessions_dir and sessions_mysql_dbh may be supplied";
1342 1 50       4 if ($para{sessions_dir}) {
    0          
1343              
1344             #
1345             # Supplied (or determined) file-based sessions storage
1346             #
1347 1 50 33     32 -e $para{sessions_dir} && !-d $para{sessions_dir} && croak "$para{sessions_dir} exists but is not a directory";
1348 1 50 33     16 -d $para{sessions_dir} || mkdir($para{sessions_dir}, 0700) || croak "Failed to create $para{sessions_dir}: $!";
1349 1 50       18 -w $para{sessions_dir} || croak "$para{sessions_dir} is not writable by me";
1350             }
1351             elsif ($para{sessions_mysql_dbh}) {
1352              
1353             #
1354             # Supplied mysql-based sessions storage
1355             # Should be a reference to mysql object - but I'll just make sure it's *a* reference to something
1356             #
1357 0 0       0 ref($para{sessions_mysql_dbh}) || croak "Invalid sessions_mysql_dbh supplied";
1358             }
1359             else {
1360 0         0 croak "Neither sessions_dir or sessions_mysql_dbh were supplied, and could not automatically determine a suitable sessions_dir";
1361             }
1362 1 50       2 if ((grep { $para{$_} } qw(sessions_serializer_default sessions_serializer_storable sessions_serializer_freezethaw)) > 1) {
  3         98  
1363 0         0 croak "Only one of sessions_serializer_default, sessions_serializer_storable and sessions_serializer_freezethaw may be supplied";
1364             }
1365 1 50       4 $para{templates_dir} || croak "templates_dir must be supplied";
1366 1 50       13 -d $para{templates_dir} || croak "$para{templates_dir} does not exist or is not a directory";
1367 1 50       14 -f "$para{templates_dir}/errors.html" || croak "Templates directory $para{templates_dir} does not contain the mandatory errors.html template";
1368 1 50       3 $para{initial_template} || croak "initial_template not supplied";
1369 1 50       11 if ($para{log_filename}) {
1370 0 0       0 open(FH, ">>$para{log_filename}") || croak "Log filename $para{log_filename} is not writeable by me: $@";
1371 0         0 close(FH);
1372             }
1373 1 50       4 if ($para{output_filter}) {
1374 0 0       0 if (ref($para{output_filter}) eq "CODE") {
  0 0       0  
1375              
1376             #
1377             # It's a code ref - good
1378             #
1379             }
1380             elsif (defined &{"$self->{callbacks_namespace}::$para{output_filter}"}) {
1381              
1382             #
1383             # It's a sub name that exists. good
1384             #
1385 0         0 $para{output_filter} = &{"$self->{callbacks_namespace}::$para{output_filter}"};
  0         0  
1386             }
1387             else {
1388 0         0 croak "Output filter not a code ref and not a sub name that I can find";
1389             }
1390             }
1391              
1392             #
1393             # And now some initialization
1394             #
1395 1         9 $self->{action} = $para{action};
1396 1         18 $self->{valid_languages} = $para{valid_languages};
1397 1         2 $self->{templates_dir} = $para{templates_dir};
1398 1         9 $self->{initial_template} = $para{initial_template};
1399 1         3 $self->{callbacks_namespace} = $para{callbacks_namespace};
1400 1         2 $self->{log_filename} = $para{log_filename};
1401 1         3 $self->{disable_back_button} = $para{disable_back_button};
1402 1         2 $self->{output_filter} = $para{output_filter};
1403 1   33     10 $self->{_cgi} = new CGI || die "Failed to create a new CGI instance: $! $@\n";
1404 1   50     10251 $cookie_value = $self->{_cgi}->cookie($para{cookie_name}) || undef;
1405              
1406 1 50       4585 if ($para{"maketext_class_name"}) {
1407 0         0 undef $@;
1408 0 0       0 eval { eval("require $para{'maketext_class_name'};") || die "Failed to require() $para{'maketext_class_name'}: $! $@"; };
  0         0  
1409 0 0       0 if ($@) {
1410 0         0 croak "Could not properly initialize maketext_class_name ($para{'maketext_class_name'}): $@";
1411             }
1412             else {
1413 0         0 $self->{maketext_class_name} = $para{"maketext_class_name"};
1414             }
1415             }
1416              
1417             #
1418             # Initialize session object
1419             #
1420 1 50       6 if ($para{sessions_dir}) {
1421 1         3 $sessions_driver = "File";
1422             }
1423             else {
1424 0         0 $sessions_driver = "MySQL";
1425             }
1426 1 50       7 if ($para{sessions_serializer_storable}) {
    50          
1427 0         0 $sessions_serializer = "Storable";
1428             }
1429             elsif ($para{sessions_serializer_freezethaw}) {
1430 0         0 $sessions_serializer = "FreezeThaw";
1431             }
1432             else {
1433 1         4 $sessions_serializer = "Default";
1434             }
1435 1   33     17 $self->{_session} = new CGI::Session(
1436             "driver:$sessions_driver;serializer:$sessions_serializer",
1437             $cookie_value,
1438             {
1439             Handle => $para{sessions_mysql_dbh},
1440             Directory => $para{sessions_dir},
1441             }
1442             )
1443             || die "Failed to create new CGI::Session instance with $sessions_driver - based storage and $sessions_serializer - based serialization: $! $@\n";
1444              
1445 1 50       73812 if ($para{"import_form"}) {
1446 0         0 $self->{_cgi}->import_names($para{"import_form"});
1447 0         0 $self->{_import_form} = $para{"import_form"};
1448             }
1449              
1450 1 50 33     7 if (!$cookie_value || ($self->{_session}->id() ne $cookie_value)) {
1451              
1452             # We just created a new session - send it to the user
1453 1 50       11 print "Set-Cookie: $para{cookie_name}=", $self->{_session}->id(), ($para{cookie_domain} ? "; domain=" . $para{cookie_domain} : ""), "\n";
1454             }
1455 1 0       50 $expire = $para{"expire"} ? ($para{"expire"} =~ /[^0-9]/ ? $para{"expire"} : "+$para{expire}m") : "+15m";
    50          
1456 1         9 $self->{_session}->expire($expire);
1457              
1458             #
1459             # Language handling
1460             #
1461 1 50 50     51 if ($self->{_cgi}->param("_lang") && scalar @{ $self->{valid_languages} }) {
  0 50 33     0  
  1         28  
1462 0 0       0 if (grep { $self->{_cgi}->param("_lang") eq $_ } @{ $self->{valid_languages} }) {
  0         0  
  0         0  
1463              
1464             #
1465             # Override session language
1466             #
1467 0         0 $self->{_session}->param("_lang", scalar $self->{_cgi}->param("_lang"));
1468             }
1469             else {
1470 0         0 print "Content-type: text/plain\n\n";
1471 0         0 print "Unsupported language\n";
1472 0         0 $self->finalize();
1473             }
1474             }
1475             elsif (scalar @{ $self->{valid_languages} } && !$self->{_session}->param("_lang")) {
1476              
1477             # Set default language
1478 0         0 $self->{_session}->param("_lang", $self->{valid_languages}->[0]);
1479             }
1480              
1481             #
1482             # We're done initializing !
1483             #
1484 1         2 $LASTINSTANCE = $self;
1485 1         12 return ($self);
1486             }
1487              
1488             #
1489             # Takes a scalar key
1490             # Copies that key from the form to the session
1491             #
1492             sub remember {
1493 0     0 1   my $self = _getself(\@_);
1494 0   0       my $sourcekey = shift || croak "key not supplied";
1495 0   0       my $destinationkey = shift || $sourcekey;
1496 0           $self->session($destinationkey, $self->form($sourcekey));
1497             }
1498              
1499             #
1500             # Takes a template name
1501             # returns scalar output string containing parsed template, with lang and tags substitution
1502             # In array mode also returns a second element which is the content-type
1503             #
1504             sub return_template {
1505 0     0 1   my $self = _getself(\@_);
1506 0   0       my $template_name = shift || croak "Template name not supplied";
1507 0           my $template;
1508             my $content_type;
1509 0           my $filename;
1510 0           my $output;
1511 0           my ($key, $value);
1512 0           my $temp;
1513 0           my $header;
1514 0           my $footer;
1515 0           my $action;
1516              
1517 1     1   20 no strict 'refs';
  1         4  
  1         854  
1518              
1519             #
1520             # Prepare template
1521             #
1522 0           ($filename, $content_type) = $self->_get_template_details($template_name);
1523 0 0         croak "Could not find template $template_name" if !$filename;
1524              
1525 0   0       $template = HTML::Template->new(
1526             filename => $filename,
1527             path => [ $self->{templates_dir} ],
1528             associate => [ $self->{_session}, $self->{_cgi} ],
1529             die_on_bad_params => 0,
1530             loop_context_vars => 1,
1531             )
1532             || die "Error creating HTML::Template instance: $! $@\n";
1533 0           $template->param($self->{_html});
1534 0           $template->param(
1535             {
1536             _form_action => $ENV{SCRIPT_NAME},
1537             _formaction => $ENV{SCRIPT_NAME},
1538             _current_template => $template_name,
1539             }
1540             );
1541 0           $output = $template->output();
1542              
1543             #
1544             # Implement language substitutions:
1545             #
1546 0           foreach (@{ $self->{valid_languages} }) {
  0            
1547 0 0         if ($self->session("_lang") eq $_) {
1548 0           $output =~ s#<$_>(.*?)#$1#gsi;
1549             }
1550             else {
1551 0           $output =~ s#<$_>(.*?)##gsi;
1552             }
1553             }
1554              
1555 0 0         if ($content_type eq "application/x-netscape-autoconfigure-dialer") {
    0          
1556              
1557             #
1558             # We're sending a netscape INS file. It needs to be formatted to binary first
1559             #
1560 0           ($output) = ($output =~ /\[netscape\]\s*\n((?:.*=.*\n)+)/i);
1561 0           $temp = "";
1562 0           foreach ("STATUS=OK", split /\n/, $output) {
1563 0           ($key, $value) = split(/=/);
1564 0           $temp .= pack("nA*nA*", length($key), $key, length($value), $value);
1565             }
1566 0           $output = $temp;
1567             }
1568             elsif ($content_type eq "text/html") {
1569              
1570             #
1571             # We're sending an html file. We need to substitute the cgi_framework_STUFF
1572             #
1573 0           foreach (qw(cgi_framework_header cgi_framework_footer)) {
1574 0 0         $output =~ /<$_>/i || croak "Error: Cumulative templates for step $template_name does not contain the required <$_> tag";
1575             }
1576 0   0       $action = $self->{action} || $ENV{"SCRIPT_NAME"};
1577 0           $header = <<"EOM";
1578            
1579            
1602            
1603            
1604            
1605            
1606            
1607            
1608             EOM
1609 0           $footer = <<"EOM";
1610            
1611            
1612            
1613             EOM
1614 0           $output =~ s//$header/i;
1615 0           $output =~ s//$footer/i;
1616             }
1617              
1618 0 0         return wantarray ? ($output, $content_type) : $output;
1619             }
1620              
1621             #
1622             # Takes a scalar key, and an optional value
1623             # Gives them to the param() method of CGI::Session
1624             #
1625             sub session {
1626 0     0 1   my $self = _getself(\@_);
1627 0   0       my $key = shift || croak "key not supplied";
1628 0           my $value = shift;
1629 0 0         return defined($value) ? $self->{_session}->param($key, $value) : $self->{_session}->param($key);
1630             }
1631              
1632             #
1633             # Takes a template name
1634             # Calls pre__pre__all() and pre_templatename() and post__pre__all()
1635             # Shows it
1636             # Calls pre__post__all() and post_templatename() and post__post__all()
1637             # THEN EXITS
1638             #
1639             sub show_template {
1640 0     0 1   my $self = _getself(\@_);
1641 0   0       my $template_name = shift || croak "Template name not supplied";
1642 0           my $nofinalize = shift;
1643 0           my $content;
1644             my $content_type;
1645              
1646 1     1   7 no strict 'refs';
  1         13  
  1         2395  
1647              
1648 0 0         if (defined &{"$self->{callbacks_namespace}::pre__pre__all"}) {
  0            
1649              
1650             #
1651             # Execute a pre__pre__all
1652             #
1653 0           &{"$self->{callbacks_namespace}::pre__pre__all"}($self, $template_name);
  0            
1654             }
1655              
1656 0 0         if (defined &{"$self->{callbacks_namespace}::pre_$template_name"}) {
  0            
1657              
1658             #
1659             # Execute a pre_ for this template
1660             #
1661 0           &{"$self->{callbacks_namespace}::pre_$template_name"}($self, $template_name);
  0            
1662             }
1663              
1664 0 0         if (defined &{"$self->{callbacks_namespace}::post__pre__all"}) {
  0            
1665              
1666             #
1667             # Execute a post__pre__all
1668             #
1669 0           &{"$self->{callbacks_namespace}::post__pre__all"}($self, $template_name);
  0            
1670             }
1671              
1672             #
1673             # Parse template
1674             #
1675 0           ($content, $content_type) = $self->return_template($template_name);
1676              
1677             #
1678             # Implement outbound filter
1679             #
1680 0 0         if ($self->{output_filter}) {
1681 0           &{ $self->{output_filter} }($self, \$content);
  0            
1682             }
1683              
1684             #
1685             # Send content
1686             #
1687 0           print "Content-type: $content_type\n";
1688 0 0         if ($self->{disable_back_button}) {
1689 0           print "Cache-control: no-cache\n";
1690 0           print "Pragma: no-cache\n";
1691 0           print "Expires: Thu, 01 Dec 1994 16:00:00 GMT\n";
1692             }
1693 0           print "\n";
1694 0           print $content;
1695 0           $self->session("_lastsent", $template_name);
1696              
1697 0 0         if (defined &{"$self->{callbacks_namespace}::pre__post__all"}) {
  0            
1698              
1699             #
1700             # Execute a pre__post__all
1701             #
1702 0           &{"$self->{callbacks_namespace}::pre__post__all"}($self, $template_name);
  0            
1703             }
1704              
1705 0 0         if (defined &{"$self->{callbacks_namespace}::post_$template_name"}) {
  0            
1706              
1707             #
1708             # Execute a post_ for this template
1709             #
1710 0           &{"$self->{callbacks_namespace}::post_$template_name"}($self);
  0            
1711             }
1712              
1713 0 0         if (defined &{"$self->{callbacks_namespace}::post__post__all"}) {
  0            
1714              
1715             #
1716             # Execute a post__post__all
1717             #
1718 0           &{"$self->{callbacks_namespace}::post__post__all"}($self, $template_name);
  0            
1719             }
1720              
1721 0 0         if (!$nofinalize) {
1722 0           $self->finalize();
1723             }
1724              
1725             }
1726              
1727             #
1728             # This sub takes whatever's passed to it and
1729             # records it in the log file
1730             #
1731             sub log_this {
1732 0     0 1   my $self = _getself(\@_);
1733 0           my $message = shift;
1734 0   0       my $filename = $self->{log_filename} || croak "Can not use log_this since no log_filename was defined in the constructor";
1735 0           local (*FH);
1736 0           $message =~ s/[\n\r]/-/g;
1737 0 0         open(FH, ">>$filename") || die "Error opening $filename: $!\n";
1738 0           flock(FH, LOCK_EX);
1739 0           seek(FH, 0, 2);
1740 0           print FH scalar(localtime), " : ", $ENV{'REMOTE_ADDR'}, " : ", $ENV{"SCRIPT_NAME"}, " : ", $message, "\n";
1741 0           flock(FH, LOCK_UN);
1742 0           close(FH);
1743 0           return (1);
1744             }
1745              
1746             #
1747             # Takes a scalar
1748             # Returns it's localized version
1749             # or exact same unmodified string if localization is not applicable in current session
1750             #
1751             sub localize {
1752 0     0 0   my $self = _getself(\@_);
1753 0   0       my $string = shift || croak "string not supplied to localize";
1754 0           my @parameters = @_;
1755 0           my $localized;
1756             my $language;
1757 0 0         $self->{"maketext_class_name"} || return $string;
1758 0 0         if (!$self->{_language_handle}) {
1759 0           foreach $language (@{ $self->{valid_languages} }) {
  0            
1760 0 0         if ($self->session("_lang") eq $language) {
1761 0           undef $@;
1762 0 0         eval { eval('$self->{_language_handle} = ' . $self->{'maketext_class_name'} . '->get_handle( "' . $language . '" );') || die "Failed to get_handle() from $self->{'maketext_class_name'}: $! $@"; };
  0            
1763 0 0         die $@ if $@;
1764 0           last;
1765             }
1766             }
1767             }
1768 0           $localized = $self->{_language_handle}->maketext($string, @parameters);
1769 0           return $localized;
1770             }
1771              
1772             ############################################################################
1773             #
1774             # PRIVATE SUBS START HERE
1775              
1776             #
1777             # Takes a templatename
1778             # If found, returns templatefilename, contenttype if wantarray and just the filename in scalar mode
1779             # otherwise, returns undef
1780             #
1781             sub _get_template_details {
1782 0     0     my $self = _getself(\@_);
1783 0   0       my $template_name = shift || croak "templatename not supplied";
1784 0           my $filename;
1785             my $content_type;
1786              
1787 0 0         if (-e "$self->{templates_dir}/$template_name.html") {
    0          
    0          
1788 0           $filename = "$template_name.html";
1789 0           $content_type = "text/html";
1790             }
1791             elsif (-e "$self->{templates_dir}/$template_name.ins") {
1792 0           $filename = "$template_name.ins";
1793 0 0         if ($ENV{HTTP_USER_AGENT} =~ /MSIE/i) {
1794 0           $content_type = "application/x-internet-signup";
1795             }
1796             else {
1797 0           $content_type = "application/x-netscape-autoconfigure-dialer";
1798             }
1799             }
1800             elsif (-e "$self->{templates_dir}/$template_name.txt") {
1801 0           $filename = "$template_name.txt";
1802 0           $content_type = "text/plain";
1803             }
1804             else {
1805 0           return undef;
1806             }
1807 0 0         return wantarray ? ($filename, $content_type) : $filename;
1808             }
1809              
1810             #
1811             # Shows the missinginfo template
1812             # If the template doesn't exist, writes it as text
1813             #
1814             sub _missinginfo {
1815 0     0     my $self = _getself(\@_);
1816 0 0         if ($self->_get_template_details("missinginfo")) {
1817 0           $self->show_template("missinginfo");
1818             }
1819             else {
1820 0           print "Content-type: text/plain\n\n";
1821 0           print "You are trying to submit a form with some missing information. Please start from the beginning.";
1822 0           $self->finalize();
1823             }
1824             }
1825              
1826             #
1827             # THIS IS A SUB, NOT A METHOD
1828             # Takes an arrayref which should be a reference to the @_ array from whatever sub's calling it
1829             # If the first argument is an instance: of this class, shifts it from the arrayref
1830             # else returns $LASTINSTANCE
1831             # or die()s if lastinstance isn't set
1832             #
1833             sub _getself {
1834 0     0     my $arrayref = shift;
1835 0           my $self;
1836 0 0         ref($arrayref) eq "ARRAY" || die "Arrayref not provided to _getself\n";
1837 0 0         if (ref($arrayref->[0]) eq "CGI::Framework") {
    0          
1838 0           $self = shift @$arrayref;
1839 0           return $self;
1840             }
1841             elsif (ref($LASTINSTANCE) eq "CGI::Framework") {
1842 0           return $LASTINSTANCE;
1843             }
1844             else {
1845 0           croak "Cannot use this method/sub without creating an instance of CGI::Framework first";
1846             }
1847             }
1848              
1849             #
1850             # THIS IS A SUB, NOT A METHOD
1851             # Takes a directory name
1852             # Creates a skeleton of a new project under it
1853             #
1854             sub INITIALIZENEWPROJECT {
1855 0   0 0 0   my $dir = shift || die "\n\nError: You must supply a directory as the first argument\n\n";
1856 0           my $cgi_dir = "$dir/cgi-bin";
1857 0           my $lib_dir = "$dir/lib";
1858 0           my $sessions_dir = "$dir/sessions";
1859 0           my $templates_dir = "$dir/templates";
1860 0           my $public_dir = "$dir/public_html";
1861 0           my $images_dir = "$public_dir/images";
1862 0           local (*FH);
1863 0           my $filename;
1864             my $content;
1865 0           my $mode;
1866              
1867 0 0         $dir =~ m#^([/\\])|(\w:)# || die "\n\nYou must specify a fully-qualified, not a relative path\n\n";
1868 0 0         -d $dir && die "\n\n$dir already exists. This is not recommended. Please specify a non-existant directory\n\n";
1869              
1870 0           print "\n\nINITIALIZING A NEW PROJECT IN $dir\n\n";
1871              
1872             #
1873             # Create the directories
1874             #
1875 0           foreach ($dir, $cgi_dir, $lib_dir, $sessions_dir, $templates_dir, $public_dir, $images_dir) {
1876 0           print "Creating directory $_ ";
1877 0 0         mkdir($_, 0755) || die "\n\n:Error: Failed to create $_ : $!\n\n";
1878 0           print "\n";
1879             }
1880 0           print "Changing $sessions_dir mode ";
1881 0 0         chmod(0777, $sessions_dir) || die "\n\nError: Failed to chmod $sessions_dir to 777: $!\n\n";
1882 0           print "\n";
1883              
1884             #
1885             # Create the files
1886             #
1887 0           foreach (
1888             [
1889             "$templates_dir/header.html", 0644, <<"EOM"
1890            
1891            
1892            
1893             Welcome to my page
1894            
1895            
1896              
1897            
1898              
1899            
1900             EOM
1901             ],
1902             [
1903             "$templates_dir/footer.html", 0644, <<"EOM"
1904            
1905            
1906            
Copyright (C) 2005 ME !!!
1907              
1908            
1909              
1910            
1911            
1912             EOM
1913             ],
1914             [
1915             "$templates_dir/login.html", 0644, <<"EOM"
1916            
1917            
1918              
1919             The time is now:
1920            

1921              
1922             Enter your username:
1923            
1924             ">
1925              
1926            

1927              
1928             Enter your password:
1929            
1930             ">
1931              
1932            

1933              
1934            
1935              
1936            
1937             EOM
1938             ],
1939             [
1940             "$templates_dir/mainmenu.html", 0644, <<"EOM"
1941            
1942            
1943              
1944             Welcome
1945            

1946             Please select from the main menu:
1947            
1948            
  • View your account details
  • 1949            
  • Log out
  • 1950            
    1951              
    1952            
    1953             EOM
    1954             ],
    1955             [
    1956             "$templates_dir/youraccount.html", 0644, <<"EOM"
    1957            
    1958            
    1959              
    1960             Your account details:
    1961            

    1962             Username:
    1963            

    1964             Your services:
    1965            
    1966            
    1967            
    1968             Type
    1969             Details
    1970             Amount Due
    1971            
    1972            
    1973            
    1974            
    1975            
    1976            
    1977            
    1978            
    1979            
    1980              
    1981            

    1982              
    1983            
    1984              
    1985            
    1986             EOM
    1987             ],
    1988             [
    1989             "$templates_dir/missinginfo.html", 0644, <<"EOM"
    1990            
    1991            
    1992              
    1993              
    1994              
    1995            
    2006              
    2007              
    2008              
    2009             PROBLEM:
    2010              
    2011             It appears that your session is missing some information. This is usually because you've just attempted to submit a session that has timed-out. Please ">click here to go to the beginning.
    2012              
    2013            
    2014             EOM
    2015             ],
    2016             [
    2017             "$templates_dir/errors.html", 0644, <<"EOM"
    2018            
    2019            
    2020            
    2021            
    2022            
    2023            
    2024             The following ERRORS have occurred:
    2025            
    2026            
    2027            
    2028            
    2029            
    2030             Please correct below and try again.
    2031            
    2032            
    2033            
    2034            
    2035            

    2036            
    2037             EOM
    2038             ],
    2039             [
    2040             "$templates_dir/logout.html", 0644, <<"EOM"
    2041            
    2042            
    2043              
    2044             You have been successfully logged out.
    2045              
    2046            
    2047             EOM
    2048             ],
    2049             [
    2050             "$cgi_dir/hello.cgi", 0755, <<"EOM"
    2051             #!$^X
    2052              
    2053             # Stub CGI created by CGI::Framework's INITIALIZENEWPROJECT command
    2054              
    2055             use strict;
    2056             use CGI::Framework;
    2057             use lib "$lib_dir";
    2058             require pre_post;
    2059             require validate;
    2060              
    2061             my \$f = new CGI::Framework (
    2062             sessions_dir => "$sessions_dir",
    2063             templates_dir => "$templates_dir",
    2064             initial_template => "login",
    2065             )
    2066             || die "Failed to create a new CGI::Framework instance: \$\@\\n";
    2067              
    2068             #
    2069             # Unless they've successfully logged in, keep showing the login page
    2070             #
    2071             if (\$f->session("authenticated") || \$f->form("_action") eq "mainmenu") {
    2072             \$f->dispatch();
    2073             }
    2074             else {
    2075             \$f->show_template("login");
    2076             }
    2077              
    2078             EOM
    2079             ],
    2080             [
    2081             "$lib_dir/validate.pm", 0644, <<"EOM"
    2082              
    2083             # Stub module created by CGI::Framework's INITIALIZENEWPROJECT command
    2084            
    2085             use strict;
    2086              
    2087             sub validate_login {
    2088             my \$f = shift;
    2089             if (!\$f->form("username")) {
    2090             \$f->add_error("You must supply your username");
    2091             }
    2092             if (!\$f->form("password")) {
    2093             \$f->add_error("You must supply your password");
    2094             }
    2095             if (\$f->form("username") eq "goodusername" && \$f->form("password") eq "cleverpassword") {
    2096             # Logged in fine
    2097             \$f->remember("username");
    2098             \$f->session("authenticated", 1);
    2099             }
    2100             elsif (\$f->form("username") && \$f->form("password")) {
    2101             \$f->add_error("Login failed");
    2102             }
    2103             }
    2104              
    2105             1;
    2106             EOM
    2107             ],
    2108             [
    2109             "$lib_dir/pre_post.pm", 0644, <<"EOM"
    2110              
    2111             # Stub module created by CGI::Framework's INITIALIZENEWPROJECT command
    2112              
    2113             use strict;
    2114              
    2115             sub pre_login {
    2116             my \$f = shift;
    2117             \$f->html("currenttime", scalar localtime(time));
    2118             }
    2119              
    2120             sub pre_youraccount {
    2121             my \$f = shift;
    2122             my \@services = (
    2123             {
    2124             type => "Cell Phone",
    2125             details => "(514) 123-4567",
    2126             amount => '\$25.00',
    2127             },
    2128             {
    2129             type => "Laptop Rental",
    2130             details => "SuperDuper Pentium 4 3.01hz",
    2131             amount => '\$35.99',
    2132             },
    2133             );
    2134             \$f->html("services", \\\@services);
    2135             }
    2136              
    2137             sub post_logout {
    2138             my \$f = shift;
    2139             \$f->clear_session();
    2140             }
    2141              
    2142             1;
    2143             EOM
    2144             ],
    2145             [ "$images_dir/dotarrow.gif", 0644, "\x47\x49\x46\x38\x39\x61\x0b\x00\x08\x00\xb3\x00\x00\xff\xff\xff\xff\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\xf9\x04\x01\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x0b\x00\x08\x00\x00\x04\x14\x10\xc8\x09\x42\xa0\xd8\xe2\x2d\xb5\xbf\xd6\x57\x81\x17\x67\x76\x25\xa7\x01\x11\x00\x3b\x00" ],
    2146             [ "$images_dir/exclamation.gif", 0644, "\x47\x49\x46\x38\x39\x61\x0e\x00\x0e\x00\xa2\xff\x00\xff\xff\xff\xff\xe6\xb3\xff\xcc\x66\x80\x80\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\xff\x0b\x41\x44\x4f\x42\x45\x3a\x49\x52\x31\x2e\x30\x02\xde\xed\x00\x21\xff\x0b\x4e\x45\x54\x53\x43\x41\x50\x45\x32\x2e\x30\x03\x01\x07\x00\x00\x21\xf9\x04\x04\x28\x00\x00\x00\x2c\x00\x00\x00\x00\x0e\x00\x0e\x00\x00\x03\x28\x08\xba\x44\xfb\x8f\x08\xe1\x20\x9b\xb3\x42\x49\xb9\x56\x5c\x87\x69\xa1\x38\x02\xa5\x39\xa6\x0d\x96\xa1\x6e\x4c\x5d\x59\xf8\xc1\xe6\x0d\xba\x3a\xdd\x47\xba\x04\x00\x21\xf9\x04\x04\x0f\x00\x00\x00\x2c\x06\x00\x03\x00\x02\x00\x08\x00\x00\x03\x04\x28\xba\xdc\x92\x00\x21\xf9\x04\x04\x0f\x00\x00\x00\x2c\x00\x00\x00\x00\x0e\x00\x0e\x00\x00\x03\x25\x08\xba\x33\xfb\x6f\x84\xe0\x20\x9b\xb3\x42\x89\xf3\xee\x9d\xc6\x81\x98\x33\x92\xe5\x89\x52\x80\x0a\x8a\xab\xa6\xb8\xf2\x55\x5a\x76\x6d\x35\x56\x02\x00\x21\xf9\x04\x04\x19\x00\x00\x00\x2c\x00\x00\x00\x00\x0e\x00\x0e\x00\x00\x03\x0d\x08\xba\xdc\xfe\x30\xca\x49\xab\xbd\x38\xeb\xed\x12\x00\x21\xf9\x04\x04\x0f\x00\x00\x00\x2c\x00\x00\x00\x00\x0e\x00\x0e\x00\x00\x03\x25\x08\xba\x33\xfb\x6f\x84\xe0\x20\x9b\xb3\x42\x89\xf3\xee\x9d\xc6\x81\x98\x33\x92\xe5\x89\x52\x80\x0a\x8a\xab\xa6\xb8\xf2\x55\x5a\x76\x6d\x35\x56\x02\x00\x21\xf9\x04\x04\x0f\x00\x00\x00\x2c\x00\x00\x00\x00\x0e\x00\x0e\x00\x00\x03\x25\x08\xba\x44\xfb\x8f\x08\xe1\x20\x9b\xb3\x42\x89\xf3\xee\x9d\xc6\x81\x98\x33\x92\xe5\x89\x52\x80\x0a\x8a\xab\xa6\xb8\xf2\x55\x5a\x76\x6d\x35\x56\x02\x00\x21\xf9\x04\x04\x28\x00\x00\x00\x2c\x06\x00\x03\x00\x02\x00\x08\x00\x00\x03\x05\x48\xba\x2c\xc2\x09\x00\x3b\x00" ],
    2147             ) {
    2148 0           ($filename, $mode, $content) = @$_;
    2149 0           print "Creating file $filename ";
    2150 0 0         open(FH, ">$filename") || die "\n\nError: Failed to open $filename for writing: $!\n\n";
    2151 0           print FH $content;
    2152 0           close(FH);
    2153 0           print "Setting permission to ", sprintf("%o", $mode), " ";
    2154 0 0         chmod($mode, $filename) || die "\n\nError: Failed to set mode on $filename to $mode: $!\n\n";
    2155 0           print "\n";
    2156             }
    2157              
    2158 0           print "\n\nDONE: Your stub project is now ready in $dir\n\n";
    2159 0           exit;
    2160             }
    2161              
    2162             ############################################################################
    2163             #
    2164             # OLD COMPATABILITY SUBS START HERE
    2165              
    2166             sub adderror {
    2167 0     0 0   return add_error(@_);
    2168             }
    2169              
    2170             sub clearsession {
    2171 0     0 0   return clear_session(@_);
    2172             }
    2173              
    2174             sub showtemplate {
    2175 0     0 0   return show_template(@_);
    2176             }
    2177              
    2178             sub logthis {
    2179 0     0 0   return log_this(@_);
    2180             }
    2181              
    2182             1;
    2183             __END__