CGI::Ex 2.09

diff --git a/Changes b/Changes
index e42fa35ead6b37ed24067bfc38d1ff0b4cf40417..2a59a1ddef32d9bdd5d95f1da3d5811a520c3667 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,11 @@
+2.09   2007-04-05
+        * Add more documentation about file paths
+        * Allow for base_dir_abs to return a single value, or an arrayref of values, or
+          a coderef that returns a single value or arrayref.
+        * Allow CGI::Ex send_status to work on mod_perl2.
+        * Add tests to cover all virtual methods in CGI::Ex::Template.
+        * Bring all virtual methods into line with TT2.18
+

 2.08   2007-03-02
         * Allow for digits passed to %*s patterns in format, and fmt or CGI::Ex::Template
         * Fix bug in validate.js to allow for non-existant fields (with replace)
 2.08   2007-03-02
         * Allow for digits passed to %*s patterns in format, and fmt or CGI::Ex::Template
         * Fix bug in validate.js to allow for non-existant fields (with replace)

diff --git a/META.yml b/META.yml
index e16c22fb7e68926062452a1abeb9cfa9523e507a..e110610d769bf8dd56f86d990e9ef86700b42607 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         CGI-Ex
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         CGI-Ex

-version:      2.08
+version:      2.09

 version_from: lib/CGI/Ex.pm
 installdirs:  site
 requires:
 version_from: lib/CGI/Ex.pm
 installdirs:  site
 requires:

diff --git a/lib/CGI/Ex.pm b/lib/CGI/Ex.pm
index 8c5e6b07ba79d01e6264fd760ad70b7b2f900794..772dcbd12306d69fb83f6cf66b91ec6590bdf6c5 100644 (file)
--- a/lib/CGI/Ex.pm
+++ b/lib/CGI/Ex.pm
@@ -24,7 +24,7 @@ use vars qw($VERSION
 use base qw(Exporter);
 
 BEGIN {
 use base qw(Exporter);
 
 BEGIN {

-    $VERSION               = '2.08';
+    $VERSION               = '2.09';

     $PREFERRED_CGI_MODULE  ||= 'CGI';
     @EXPORT = ();
     @EXPORT_OK = qw(get_form
     $PREFERRED_CGI_MODULE  ||= 'CGI';
     @EXPORT = ();
     @EXPORT_OK = qw(get_form


@@ -440,7 +440,9 @@ sub send_status {
             $r->send_http_header;
             $r->print($mesg);
         } else {
             $r->send_http_header;
             $r->print($mesg);
         } else {

-            # not sure of best way to send the message in MP2
+            $r->content_type('text/html');
+            $r->print($mesg);
+            $r->rflush;

         }
     } else {
         print "Status: $code\r\n";
         }
     } else {
         print "Status: $code\r\n";

diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm
index 296285893b1e55f18783cfc7c24a5d9504215cf6..a0ccaa9c686061fc16967c83e1cb474507ce5d8a 100644 (file)
--- a/lib/CGI/Ex/App.pm
+++ b/lib/CGI/Ex/App.pm
@@ -10,7 +10,7 @@ use strict;
 use vars qw($VERSION);
 
 BEGIN {
 use vars qw($VERSION);
 
 BEGIN {

-    $VERSION = '2.08';
+    $VERSION = '2.09';

 
     Time::HiRes->import('time') if eval {require Time::HiRes};
     eval {require Scalar::Util};
 
     Time::HiRes->import('time') if eval {require Time::HiRes};
     eval {require Scalar::Util};


@@ -824,12 +824,15 @@ sub swap_template {
     my $args = $self->run_hook('template_args', $step);
     my $copy = $self;
     eval {require Scalar::Util; Scalar::Util::weaken($copy)};
     my $args = $self->run_hook('template_args', $step);
     my $copy = $self;
     eval {require Scalar::Util; Scalar::Util::weaken($copy)};

-    $args->{'INCLUDE_PATH'} ||= sub { $copy->base_dir_abs || die "Could not find base_dir_abs while looking for template INCLUDE_PATH on step \"$step\"" };
-
-    require CGI::Ex::Template;
-    my $t = CGI::Ex::Template->new($args);
+    $args->{'INCLUDE_PATH'} ||= sub {
+        my $dir = $copy->base_dir_abs || die "Could not find base_dir_abs while looking for template INCLUDE_PATH on step \"$step\"";
+        $dir = $dir->() if UNIVERSAL::isa($dir, 'CODE');
+        return $dir;
+    };

 
 

+    my $t   = $self->template_obj($args);

     my $out = '';
     my $out = '';

+

     $t->process($file, $swap, \$out) || die $t->error;
 
     return $out;
     $t->process($file, $swap, \$out) || die $t->error;
 
     return $out;


@@ -837,6 +840,13 @@ sub swap_template {
 
 sub template_args { {} }
 
 
 sub template_args { {} }
 

+sub template_obj {
+    my ($self, $args) = @_;
+
+    require CGI::Ex::Template;
+    my $t = CGI::Ex::Template->new($args);
+}
+

 sub fill_template {
     my ($self, $step, $outref, $fill) = @_;
 
 sub fill_template {
     my ($self, $step, $outref, $fill) = @_;
 


@@ -859,11 +869,6 @@ sub finalize   { 1 } # failure means show step
 sub post_print { 0 }
 sub post_step  { 0 } # success indicates we handled step (don't continue step or loop)
 
 sub post_print { 0 }
 sub post_step  { 0 } # success indicates we handled step (don't continue step or loop)
 

-sub name_step {
-    my ($self, $step) = @_;
-    return $step;
-}
-

 sub morph_package {
     my $self = shift;
     my $step = shift || '';
 sub morph_package {
     my $self = shift;
     my $step = shift || '';


@@ -885,6 +890,11 @@ sub name_module {
     };
 }
 
     };
 }
 

+sub name_step {
+    my ($self, $step) = @_;
+    return $step;
+}
+

 sub file_print {
     my $self = shift;
     my $step = shift;
 sub file_print {
     my $self = shift;
     my $step = shift;


@@ -903,15 +913,27 @@ sub file_val {
     my $self = shift;
     my $step = shift;
 
     my $self = shift;
     my $step = shift;
 

-    my $abs      = $self->base_dir_abs || return {};
+    ### determine the path to begin looking for files - allow for an arrayref
+    my $abs = $self->base_dir_abs || [];
+    $abs = $abs->() if UNIVERSAL::isa($abs, 'CODE');
+    $abs = [$abs] if ! UNIVERSAL::isa($abs, 'ARRAY');
+    return {} if @$abs == 0;
+

     my $base_dir = $self->base_dir_rel;
     my $module   = $self->run_hook('name_module', $step);
     my $base_dir = $self->base_dir_rel;
     my $module   = $self->run_hook('name_module', $step);

-    my $_step    = $self->run_hook('name_step', $step);
+    my $_step    = $self->run_hook('name_step', $step) || die "Missing name_step";

     $_step .= '.'. $self->ext_val if $_step !~ /\.\w+$/;
 
     $_step .= '.'. $self->ext_val if $_step !~ /\.\w+$/;
 

-    foreach ($abs, $base_dir, $module) { $_ .= '/' if length($_) && ! m|/$| }
+    foreach (@$abs, $base_dir, $module) { $_ .= '/' if length($_) && ! m|/$| }
+
+    if (@$abs > 1) {
+        foreach my $_abs (@$abs) {
+            my $path = $_abs . $base_dir . $module . $_step;
+            return $path if -e $path;
+        }
+    }

 
 

-    return $abs . $base_dir . $module . $_step;
+    return $abs->[0] . $base_dir . $module . $_step;

 }
 
 sub info_complete {
 }
 
 sub info_complete {


@@ -1079,18 +1101,18 @@ sub base_dir_abs {
     return $self->{'base_dir_abs'} || '';
 }
 
     return $self->{'base_dir_abs'} || '';
 }
 

-sub ext_val {
-    my $self = shift;
-    $self->{'ext_val'} = shift if $#_ != -1;
-    return $self->{'ext_val'} || 'val';
-}
-

 sub ext_print {
     my $self = shift;
     $self->{'ext_print'} = shift if $#_ != -1;
     return $self->{'ext_print'} || 'html';
 }
 
 sub ext_print {
     my $self = shift;
     $self->{'ext_print'} = shift if $#_ != -1;
     return $self->{'ext_print'} || 'html';
 }
 

+sub ext_val {
+    my $self = shift;
+    $self->{'ext_val'} = shift if $#_ != -1;
+    return $self->{'ext_val'} || 'val';
+}
+

 ### where to find the javascript files
 ### default to using this script as a handler
 sub js_uri_path {
 ### where to find the javascript files
 ### default to using this script as a handler
 sub js_uri_path {

diff --git a/lib/CGI/Ex/App.pod b/lib/CGI/Ex/App.pod
index f44f9602b38d1274a4875699f0efe82bbba930fe..e0a539f5a3faf45ca9df9a55cfa210f3daef0406 100644 (file)
--- a/lib/CGI/Ex/App.pod
+++ b/lib/CGI/Ex/App.pod
@@ -20,15 +20,17 @@ There is a longer "SYNOPSIS" after the process flow discussion.
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 

-Fill in the blanks and get a ready made web application.  This module
-is somewhat similar in spirit to CGI::Application, CGI::Path, and
-CGI::Builder and any other "CGI framework."  As with the others,
-CGI::Ex::App tries to do as much of the mundane things, in a simple
-manner, without getting in the developer's way.  However, there are
-various design patterns for CGI applications that CGI::Ex::App handles
-for you that the other frameworks require you to bring in extra support.
-The entire CGI::Ex suite has been taylored to work seamlessly together.
-Your mileage in building applications may vary.
+Fill in the blanks and get a ready made web application.
+
+This module is somewhat similar in spirit to CGI::Application,
+CGI::Path, and CGI::Builder and any other "CGI framework."  As with
+the others, CGI::Ex::App tries to do as much of the mundane things, in
+a simple manner, without getting in the developer's way.  However,
+there are various design patterns for CGI applications that
+CGI::Ex::App handles for you that the other frameworks require you to
+bring in extra support.  The entire CGI::Ex suite has been taylored to
+work seamlessly together.  Your mileage in building applications may
+vary.

 
 If you build applications that submit user information, validate it,
 re-display it, fill in forms, or separate logic into separate modules,
 
 If you build applications that submit user information, validate it,
 re-display it, fill in forms, or separate logic into separate modules,


@@ -40,8 +42,8 @@ to write any code, this module will help - but you still need to
 provide your key actions and html.
 
 One of the great benefits of CGI::Ex::App vs. Catalyst or Rails style
 provide your key actions and html.
 
 One of the great benefits of CGI::Ex::App vs. Catalyst or Rails style

-frameworks is that the model of CGI::Ex::App can be much more abstract
-as models often are.
+frameworks is that the model of CGI::Ex::App can be much more abstract.
+And models often are abstract.

 
 =head1 DEFAULT PROCESS FLOW
 
 
 =head1 DEFAULT PROCESS FLOW
 


@@ -184,7 +186,7 @@ Because of the hook based system, and because CGI::Ex::App uses
 sensible defaults, it is very easy to override a little or a lot which
 ends up giving the developer a lot of flexibility.
 
 sensible defaults, it is very easy to override a little or a lot which
 ends up giving the developer a lot of flexibility.
 

-Consequently, it should be possible to use CGI::Ex::App with the other
+Additionally, it should be possible to use CGI::Ex::App with the other

 frameworks such as CGI::Application or CGI::Prototype.  For these you
 could simple let each "runmode" call the run_step hook of CGI::Ex::App
 and you will instantly get all of the common process flow for free.
 frameworks such as CGI::Application or CGI::Prototype.  For these you
 could simple let each "runmode" call the run_step hook of CGI::Ex::App
 and you will instantly get all of the common process flow for free.


@@ -193,33 +195,33 @@ and you will instantly get all of the common process flow for free.
 
 The default out of the box configuration will map URIs to steps as follows:
 
 
 The default out of the box configuration will map URIs to steps as follows:
 

-    # Assuming /cgi-bin/my_cgi is the program being run
+    # Assuming /cgi-bin/my_app is the program being run

 
 

-    URI:  /cgi-bin/my_cgi
+    URI:  /cgi-bin/my_app

     STEP: main
     FORM: {}
     WHY:  No other information is passed.  The path method is
           called which eventually calls ->default_step which
           defaults to "main"
 
     STEP: main
     FORM: {}
     WHY:  No other information is passed.  The path method is
           called which eventually calls ->default_step which
           defaults to "main"
 

-    URI:  /cgi-bin/my_cgi?foo=bar
+    URI:  /cgi-bin/my_app?foo=bar

     STEP: main
     FORM: {foo => "bar"}
     WHY:  Same as previous example except that QUERY_STRING
           information was passed and placed in form.
 
     STEP: main
     FORM: {foo => "bar"}
     WHY:  Same as previous example except that QUERY_STRING
           information was passed and placed in form.
 

-    URI:  /cgi-bin/my_cgi?step=my_step
+    URI:  /cgi-bin/my_app?step=my_step

     STEP: my_step
     FORM: {step => "my_step"}
     WHY:  The path method is called which looks in $self->form
           for the key ->step_key (which defaults to "step").
 
     STEP: my_step
     FORM: {step => "my_step"}
     WHY:  The path method is called which looks in $self->form
           for the key ->step_key (which defaults to "step").
 

-    URI:  /cgi-bin/my_cgi?step=my_step&foo=bar
+    URI:  /cgi-bin/my_app?step=my_step&foo=bar

     STEP: my_step
     FORM: {foo => "bar", step => "my_step"}
     WHY:  Same as before but has other parameters were passed.
 
     STEP: my_step
     FORM: {foo => "bar", step => "my_step"}
     WHY:  Same as before but has other parameters were passed.
 

-    URI:  /cgi-bin/my_cgi/my_step
+    URI:  /cgi-bin/my_app/my_step

     STEP: my_step
     FORM: {step => "my_step"}
     WHY:  The path method is called which called path_info_map_base
     STEP: my_step
     FORM: {step => "my_step"}
     WHY:  The path method is called which called path_info_map_base


@@ -229,12 +231,12 @@ The default out of the box configuration will map URIs to steps as follows:
           $self->form->{$self->step_key} for the initial step. See
           the path_info_map_base method for more information.
 
           $self->form->{$self->step_key} for the initial step. See
           the path_info_map_base method for more information.
 

-    URI:  /cgi-bin/my_cgi/my_step?foo=bar
+    URI:  /cgi-bin/my_app/my_step?foo=bar

     STEP: my_step
     FORM: {foo => "bar", step => "my_step"}
     WHY:  Same as before but other parameters were passed.
 
     STEP: my_step
     FORM: {foo => "bar", step => "my_step"}
     WHY:  Same as before but other parameters were passed.
 

-    URI:  /cgi-bin/my_cgi/my_step?step=other_step
+    URI:  /cgi-bin/my_app/my_step?step=other_step

     STEP: other_step
     FORM: {step => "other_step"}
     WHY:  The same procedure took place, but when the PATH_INFO
     STEP: other_step
     FORM: {step => "other_step"}
     WHY:  The same procedure took place, but when the PATH_INFO


@@ -252,7 +254,7 @@ that the following method is installed in your script.
         ];
     }
 
         ];
     }
 

-    URI:  /cgi-bin/my_cgi/my_step/bar
+    URI:  /cgi-bin/my_app/my_step/bar

     STEP: my_step
     FORM: {foo => "bar"}
     WHY:  The step was matched as in previous examples using
     STEP: my_step
     FORM: {foo => "bar"}
     WHY:  The step was matched as in previous examples using


@@ -262,7 +264,7 @@ that the following method is installed in your script.
           and the corresponding matched value was placed into
           the form using the keys specified following the regex.
 
           and the corresponding matched value was placed into
           the form using the keys specified following the regex.
 

-    URI:  /cgi-bin/my_cgi/my_step/bar/1234
+    URI:  /cgi-bin/my_app/my_step/bar/1234

     STEP: my_step
     FORM: {foo => "bar", id => "1234"}
     WHY:  Same as the previous example, except that the first
     STEP: my_step
     FORM: {foo => "bar", id => "1234"}
     WHY:  Same as the previous example, except that the first


@@ -272,19 +274,19 @@ that the following method is installed in your script.
           order that will match the most data.  The third regex
           would also match this PATH_INFO.
 
           order that will match the most data.  The third regex
           would also match this PATH_INFO.
 

-    URI:  /cgi-bin/my_cgi/my_step/some/other/type/of/data
+    URI:  /cgi-bin/my_app/my_step/some/other/type/of/data

     STEP: my_step
     FORM: {anything_else => 'some/other/type/of/data'}
     WHY:  Same as the previous example, except that the third
           regex matched.
 
     STEP: my_step
     FORM: {anything_else => 'some/other/type/of/data'}
     WHY:  Same as the previous example, except that the third
           regex matched.
 

-    URI:  /cgi-bin/my_cgi/my_step/bar?bling=blang
+    URI:  /cgi-bin/my_app/my_step/bar?bling=blang

     STEP: my_step
     FORM: {foo => "bar", bling => "blang"}
     WHY:  Same as the first step, but additional QUERY_STRING
           information was passed.
 
     STEP: my_step
     FORM: {foo => "bar", bling => "blang"}
     WHY:  Same as the first step, but additional QUERY_STRING
           information was passed.
 

-    URI:  /cgi-bin/my_cgi/my_step/one%20two?bar=three%20four
+    URI:  /cgi-bin/my_app/my_step/one%20two?bar=three%20four

     STEP: my_step
     FORM: {anything_else => "one two", bar => "three four"}
     WHY:  The third path_info_map regex matched.  Note that the
     STEP: my_step
     FORM: {anything_else => "one two", bar => "three four"}
     WHY:  The third path_info_map regex matched.  Note that the


@@ -303,8 +305,15 @@ how GET and POST parameters are parsed.
 See the path_info_map_base method, and path_info_map hook for more information
 on how the path_info maps function.
 
 See the path_info_map_base method, and path_info_map hook for more information
 on how the path_info maps function.
 

-A Dumper($self->dump_history) is very useful for determing what hooks have
-taken place.
+Using the following code is very useful for determing what hooks have
+taken place:
+
+   use CGI::Ex::Dump qw(debug);
+
+   sub post_navigate {
+       my $self = shift;
+       debug $self->dump_history, $self->form;
+   }

 
 =head1 ADDING DATA VALIDATION TO A STEP
 
 
 =head1 ADDING DATA VALIDATION TO A STEP
 


@@ -423,6 +432,130 @@ fill_args hooks for more information.
 The default form filler is CGI::Ex::Fill which is similar to HTML::FillInForm but
 has several benefits.  See the CGI::Ex::Fill module for the available options.
 
 The default form filler is CGI::Ex::Fill which is similar to HTML::FillInForm but
 has several benefits.  See the CGI::Ex::Fill module for the available options.
 

+=head1 FINDING TEMPLATES AND VALIDATION FILES
+
+CGI::Ex::App tries to help your applications use a good template directory layout, but allows
+for you to override everything.
+
+External template files are used for storing your html templates and
+for storing your validation files (if you use externally stored
+validation files).
+
+The default file_print hook will look for content on your file system,
+but it can also be completely overridden to return a reference to a
+scalar containing the contents of your file.  Actually it can return
+anything that CGI::Ex::Template (Template::Toolkit compatible) will
+treat as input.  This templated html is displayed to the user during
+any step that enters the "print" phase.
+
+Similarly the default file_val hook will look for a validation file on
+the file system, but it too can return a reference to a scalar
+containing the contents of a validation file.  It may actually return
+anything that the CGI::Ex::Validate get_validation method is able to
+understand.  This validation is used by the default "info_complete"
+method for verifying if the submitted information passes its specific
+checks.  A more common way of inlining validation is to return a
+validation hash from a hash_validation hook override.
+
+If the default file_print and file_val hooks are used, the following methods
+are employed for finding templates and validation files on your filesystem (they
+are also documented more in the HOOKS AND METHODS section.
+
+=over 4
+
+=item base_dir_abs
+
+Absolute path or arrayref of paths to the base templates directory.  Default "".
+
+=item base_dir_rel
+
+Relative path inside of the base_dir_abs directory where content can be found.  Default "".
+
+=item name_module
+
+Directory inside of base_dir_rel where files for the current CGI (module) will be
+stored.  Default value is $ENV{SCRIPT_NAME} with path and extension removed.
+
+=item name_step
+
+Used with ext_print and ext_val for creating the filename that will be looked for
+inside of the name_module directory.  Default value is the current step.
+
+=item ext_print and ext_val
+
+Filename extensions added to name_step to create the filename looked for
+inside of the name_module directory.  Default is "html" for ext_print and "val"
+for ext_val.
+
+=back
+
+It may be easier to understand the usage of each of these methods by showing
+a contrived example.  The following is a hypothetical layout for your templates:
+
+    /home/user/templates/
+    /home/user/templates/chunks/
+    /home/user/templates/wrappers/
+    /home/user/templates/content/
+    /home/user/templates/content/my_app/
+    /home/user/templates/content/my_app/main.html
+    /home/user/templates/content/my_app/step1.html
+    /home/user/templates/content/my_app/step1.val
+    /home/user/templates/content/another_cgi/main.html
+
+In this example we would most likely set values as follows:
+
+    base_dir_abs  /home/user/templates
+    base_dir_rel  content
+    name_module   my_app
+
+The name_module method defaults to the name of the running program, but
+with the path and extension removed.  So if we were running
+/cgi-bin/my_app.pl, /cgi-bin/my_app, or /anypath/my_app, then
+name_module would default to "my_app" and we wouldn't have to
+hard code the value.  Often it is wise to set the value anyway so
+that we can change the name of the cgi script without effecting
+where template content should be stored.
+
+Continuing with the example and assuming that name of the step that
+the user has requested is "step1" then the following values would be
+returned:
+
+    base_dir_abs  /home/user/templates
+    base_dir_rel  content
+    name_module   my_app
+    name_step     step1
+    ext_print     html
+    ext_val       val
+
+    file_print    content/my_app/step1.html
+    file_val      /home/user/templates/content/my_app/step1.val
+
+The call to the template engine would look something like
+the following:
+
+    my $t = $self->template_obj({
+        INCLUDE_PATH => $self->base_dir_abs,
+    });
+
+    $t->process($self->file_print($step), \%vars);
+
+The template engine would then look for the relative file
+inside of the absolute paths (from base_dir_abs).
+
+The call to the validation engine would pass the absolute
+filename that is returned by file_val.
+
+The name_module and name_step methods can return filenames with
+additional directories included.  The previous example could
+also have been setup using the following values:
+
+    base_dir_abs  /home/user/templates
+    base_dir_rel
+    name_module   content/my_app
+
+In this case the same values would be returned for the file_print and file_val hooks
+as were returned in the previous setup.
+

 =head1 SYNOPSIS (A LONG "SYNOPSIS")
 
 This example script would most likely be in the form of a cgi, accessible via
 =head1 SYNOPSIS (A LONG "SYNOPSIS")
 
 This example script would most likely be in the form of a cgi, accessible via


@@ -789,15 +922,55 @@ was successful - so this data can be defined but false.
 
 See the get_valid_auth method.
 
 
 See the get_valid_auth method.
 

+=item base_dir_abs (method)
+
+Used as the absolute base directory to find template files and validation files.
+It may return a single value or an arrayref of values, or a coderef that
+returns an arrayref or coderef of values.  You may pass base_dir_abs
+as a parameter in the arguments passed to the "new" method.
+
+Default value is "".
+
+For example, to pass multiple paths, you would use something
+similar to the following:
+
+    sub base_dir_abs {
+        return ['/my/path/one', '/some/other/path'];
+    }
+
+The base_dir_abs value is used along with the base_dir_rel, name_module,
+name_step, ext_print and ext_values for determining the values
+returned by the default file_print and file_val hooks.  See those methods
+for further discussion.
+
+See the section on FINDING TEMPLATES for further discussion.
+
+=item base_dir_rel (method)
+
+Added as a relative base directory to content under the base_dir_abs directory.
+
+Default value is "".
+
+The base_dir_abs method is used as top level where template includes may
+pull from, while the base_dir_rel is directory relative to the base_dir_abs
+where the content files will be stored.
+
+A value for base_dir_rel may passed as a parameter in the arguments passed
+to the new method.
+
+See the base_dir_abs method for more discussion.
+
+See the section on FINDING TEMPLATES for further discussion.
+

 =item cleanup_user (method)
 
 =item cleanup_user (method)
 

-Installed as a hook during get_valid_auth.  Allows for cleaning
+Used as a hook during get_valid_auth.  Allows for cleaning

 up the username.  See the get_valid_auth method.
 
 up the username.  See the get_valid_auth method.
 

-     sub cleanup_user {
-         my ($self, $user) = @_;
-         return lc $user;
-     }
+    sub cleanup_user {
+        my ($self, $user) = @_;
+        return lc $user;
+    }

 
 =item clear_app (method)
 
 
 =item clear_app (method)
 


@@ -913,6 +1086,28 @@ hooks for the current and remaining steps.  It is used to allow the
 unmorphed before returning.  Also - the post_navigate method will
 still be called.
 
 unmorphed before returning.  Also - the post_navigate method will
 still be called.
 

+=item ext_print (method)
+
+Added as suffix to "name_step" during the default file_print hook.
+
+Default value is 'html'.
+
+For example, if name_step returns "foo" and ext_print returns "html"
+then the file "foo.html" will be searched for.
+
+See the section on FINDING TEMPLATES for further discussion.
+
+=item ext_val (method)
+
+Added as suffix to "name_step" during the default file_val hook.
+
+Default value is 'val'.
+
+For example, if name_step returns "foo" and ext_val returns "val"
+then the file "foo.val" will be searched for.
+
+See the section on FINDING TEMPLATES for further discussion.
+

 =item first_step (method)
 
 Returns the first step of the path.  Note that first_step may not be the same
 =item first_step (method)
 
 Returns the first step of the path.  Note that first_step may not be the same


@@ -994,7 +1189,9 @@ the data for the application in a single location.
 Returns a filename containing the validation.  Performs the same
 as file_print, but uses ext_val to get the extension, and it adds
 base_dir_abs onto the returned value (file_print is relative to
 Returns a filename containing the validation.  Performs the same
 as file_print, but uses ext_val to get the extension, and it adds
 base_dir_abs onto the returned value (file_print is relative to

-base_dir_abs, while file_val is fully qualified with base_dir_abs)
+base_dir_abs, while file_val is fully qualified with base_dir_abs).
+If base_dir_abs returns an arrayref of paths, then each path is
+checked for the existence of the file.

 
 The file should be readable by CGI::Ex::Validate::get_validation.
 
 
 The file should be readable by CGI::Ex::Validate::get_validation.
 


@@ -1418,12 +1615,16 @@ have its own directory for storing html for its steps.
 
 See the file_print method for more information.
 
 
 See the file_print method for more information.
 

+See the section on FINDING TEMPLATES for further discussion.
+

 =item name_step (hook)
 
 Return the step (appended to name_module) that should used when
 looking up the file in file_print and file_val lookups.  Defaults to
 the current step.
 
 =item name_step (hook)
 
 Return the step (appended to name_module) that should used when
 looking up the file in file_print and file_val lookups.  Defaults to
 the current step.
 

+See the section on FINDING TEMPLATES for further discussion.
+

 =item nav_loop (method)
 
 This is the main loop runner.  It figures out the current path
 =item nav_loop (method)
 
 This is the main loop runner.  It figures out the current path


@@ -1831,20 +2032,67 @@ through the current template engine (default engine is CGI::Ex::Template).
 
 Arguments are the template and the swap hashref.  The template can be either a
 scalar reference to the actual content, or the filename of the content.  If the
 
 Arguments are the template and the swap hashref.  The template can be either a
 scalar reference to the actual content, or the filename of the content.  If the

-filename is specified - it should be relative to base_dir_abs.
+filename is specified - it should be relative to base_dir_abs (which will be
+used to initialize INCLUDE_PATH by default).
+
+The default method will create a template object by calling the template_args hook
+and passing the returned hashref to the template_obj method.  The default template_obj method
+returns a CGI::Ex::Template object, but could easily be swapped to use a Template::Toolkit
+based object.  If a non-Template::Toolkit compatible object is to be used, then
+the swap_template hook can be overridden to use another templating engine.
+
+For example to use the HTML::Template engine you could override the swap_template
+method as follows:
+
+    use HTML::Template;
+
+    sub swap_template {
+        my ($self, $step, $file, $swap) = @_;
+
+        my $type = UNIVERSAL::isa($file, 'SCALAR') ? 'scalarref'
+                 : UNIVERSAL::isa($file, 'ARRAY')  ? 'arrayref'
+                 : ref($file)                      ? 'filehandle'
+                 :                                   'filename';
+
+        my $t = HTML::Template->new(source => $file,
+                                    type   => $type,
+                                    path   => $self->base_dir_abs,
+                                    die_on_bad_params => 0,
+                                    );
+
+        $t->param($swap);
+
+        return $t->output;
+    }

 
 =item template_args (hook)
 
 Returns a hashref of args that will be passed to the "new" method of CGI::Ex::Template.
 
 =item template_args (hook)
 
 Returns a hashref of args that will be passed to the "new" method of CGI::Ex::Template.

-By default this hashref contains INCLUDE_PATH which is set equal to base_dir_abs.
-It can be augmented with any arguments that CGI::Ex::Template would understand.
-
-   sub template_args {
-       return {
-           INCLUDE_PATH => '/my/own/include/path',
-           WRAPPER => 'wrappers/main_wrapper.html',
-       };
-   }
+The method is normally called from the swap_template hook.  The swap_template hook
+will add a value for INCLUDE_PATH which is set equal to base_dir_abs, if the INCLUDE_PATH
+value is not already set.
+
+The returned hashref can contain any arguments that CGI::Ex::Template would understand.
+
+    sub template_args {
+        return {
+            PRE_CHOMP => 1,
+            WRAPPER   => 'wrappers/main_wrapper.html',
+        };
+    }
+
+=item template_obj (method)
+
+Called from swap_template.  It is passed the result of template_args that have
+had a default INCLUDE_PATH added.  The default implementation uses CGI::Ex::Template
+but can easily be changed to use Template::Toolkit by using code similar to the following:
+
+    use Template;
+
+    sub template_obj {
+        my ($self, $args) = @_;
+        return Template->new($args);
+    }

 
 =item unmorph (method)
 
 
 =item unmorph (method)
 


@@ -2615,4 +2863,8 @@ the original versions.
 
 Paul Seamons <paul at seamons dot com>
 
 
 Paul Seamons <paul at seamons dot com>
 

+=head1 LICENSE
+
+This module may be distributed under the same terms as Perl itself.
+

 =cut
 =cut

diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm
index fe9f776e125cb70732cdbeaf92c8609f33ed5816..1c060a1e747b28d19f374933cb2c876a99ada064 100644 (file)
--- a/lib/CGI/Ex/Auth.pm
+++ b/lib/CGI/Ex/Auth.pm
@@ -18,7 +18,7 @@ use MIME::Base64 qw(encode_base64 decode_base64);
 use Digest::MD5 qw(md5_hex);
 use CGI::Ex;
 
 use Digest::MD5 qw(md5_hex);
 use CGI::Ex;
 

-$VERSION = '2.08';
+$VERSION = '2.09';

 
 ###----------------------------------------------------------------###
 
 
 ###----------------------------------------------------------------###
 

diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm
index 145f16ac7edcf1784aa1c2b1978b6e8b02973396..5d8ab5f2734d747f1c00e759aecd643a6018b931 100644 (file)
--- a/lib/CGI/Ex/Conf.pm
+++ b/lib/CGI/Ex/Conf.pm
@@ -29,7 +29,7 @@ use vars qw($VERSION
             );
 @EXPORT_OK = qw(conf_read conf_write in_cache);
 
             );
 @EXPORT_OK = qw(conf_read conf_write in_cache);
 

-$VERSION = '2.08';
+$VERSION = '2.09';

 
 $DEFAULT_EXT = 'conf';
 
 
 $DEFAULT_EXT = 'conf';
 

diff --git a/lib/CGI/Ex/Die.pm b/lib/CGI/Ex/Die.pm
index f1c5e9fe0d844f4cc139f3960bb9dcb6263dbca3..b10644df375193658a8d36feae11c9036b635c98 100644 (file)
--- a/lib/CGI/Ex/Die.pm
+++ b/lib/CGI/Ex/Die.pm
@@ -23,7 +23,7 @@ use CGI::Ex;
 use CGI::Ex::Dump qw(debug ctrace dex_html);
 
 BEGIN {
 use CGI::Ex::Dump qw(debug ctrace dex_html);
 
 BEGIN {

-  $VERSION = '2.08';
+  $VERSION = '2.09';

   $SHOW_TRACE = 0      if ! defined $SHOW_TRACE;
   $IGNORE_EVAL = 0     if ! defined $IGNORE_EVAL;
   $EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS;
   $SHOW_TRACE = 0      if ! defined $SHOW_TRACE;
   $IGNORE_EVAL = 0     if ! defined $IGNORE_EVAL;
   $EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS;

diff --git a/lib/CGI/Ex/Dump.pm b/lib/CGI/Ex/Dump.pm
index bffe94d37ee6e839a9b21fabf5d031c90e7c3fc3..3e4d1f895bead58a42421a6965c931390fa3432a 100644 (file)
--- a/lib/CGI/Ex/Dump.pm
+++ b/lib/CGI/Ex/Dump.pm
@@ -17,7 +17,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION
 use strict;
 use Exporter;
 
 use strict;
 use Exporter;
 

-$VERSION   = '2.08';
+$VERSION   = '2.09';

 @ISA       = qw(Exporter);
 @EXPORT    = qw(dex dex_warn dex_text dex_html ctrace dex_trace);
 @EXPORT_OK = qw(dex dex_warn dex_text dex_html ctrace dex_trace debug);
 @ISA       = qw(Exporter);
 @EXPORT    = qw(dex dex_warn dex_text dex_html ctrace dex_trace);
 @EXPORT_OK = qw(dex dex_warn dex_text dex_html ctrace dex_trace debug);

diff --git a/lib/CGI/Ex/Fill.pm b/lib/CGI/Ex/Fill.pm
index 6c407806605e35e3fe02031db4ca52b7171d092e..ca727f2660aaa7ecde8f80ffdd19f3aac15576f8 100644 (file)
--- a/lib/CGI/Ex/Fill.pm
+++ b/lib/CGI/Ex/Fill.pm
@@ -24,7 +24,7 @@ use vars qw($VERSION
 use base qw(Exporter);
 
 BEGIN {
 use base qw(Exporter);
 
 BEGIN {

-    $VERSION   = '2.08';
+    $VERSION   = '2.09';

     @EXPORT    = qw(form_fill);
     @EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key);
 };
     @EXPORT    = qw(form_fill);
     @EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key);
 };

diff --git a/lib/CGI/Ex/JSONDump.pm b/lib/CGI/Ex/JSONDump.pm
index d566b2f860927df14763f96cc64359803b6daa29..414920ba90ff0539c415eb44d56ef8810c543fc4 100644 (file)
--- a/lib/CGI/Ex/JSONDump.pm
+++ b/lib/CGI/Ex/JSONDump.pm
@@ -17,7 +17,7 @@ use strict;
 use base qw(Exporter);
 
 BEGIN {
 use base qw(Exporter);
 
 BEGIN {

-    $VERSION  = '2.08';
+    $VERSION  = '2.09';

 
     @EXPORT = qw(JSONDump);
     @EXPORT_OK = @EXPORT;
 
     @EXPORT = qw(JSONDump);
     @EXPORT_OK = @EXPORT;

diff --git a/lib/CGI/Ex/Template.pm b/lib/CGI/Ex/Template.pm
index 5f8c1778f89873ce2c2ffd9afeeddee9c6f1d6d2..48e900a44f7dc8f66b128a683e8475a3c4ceeca9 100644 (file)
--- a/lib/CGI/Ex/Template.pm
+++ b/lib/CGI/Ex/Template.pm
@@ -39,7 +39,7 @@ use vars qw($VERSION
             );
 
 BEGIN {
             );
 
 BEGIN {

-    $VERSION = '2.08';
+    $VERSION = '2.09';

 
     $PACKAGE_EXCEPTION   = 'CGI::Ex::Template::Exception';
     $PACKAGE_ITERATOR    = 'CGI::Ex::Template::Iterator';
 
     $PACKAGE_EXCEPTION   = 'CGI::Ex::Template::Exception';
     $PACKAGE_ITERATOR    = 'CGI::Ex::Template::Iterator';


@@ -59,17 +59,18 @@ BEGIN {
     };
 
     $SCALAR_OPS = {
     };
 
     $SCALAR_OPS = {

-        '0'      => sub { shift },
+        '0'      => sub { $_[0] },

         as       => \&vmethod_as_scalar,
         chunk    => \&vmethod_chunk,
         collapse => sub { local $_ = $_[0]; s/^\s+//; s/\s+$//; s/\s+/ /g; $_ },
         as       => \&vmethod_as_scalar,
         chunk    => \&vmethod_chunk,
         collapse => sub { local $_ = $_[0]; s/^\s+//; s/\s+$//; s/\s+/ /g; $_ },

-        defined  => sub { 1 },
+        defined  => sub { defined $_[0] ? 1 : '' },

         indent   => \&vmethod_indent,
         int      => sub { local $^W; int $_[0] },
         fmt      => \&vmethod_as_scalar,
         'format' => \&vmethod_format,
         hash     => sub { {value => $_[0]} },
         html     => sub { local $_ = $_[0]; s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; s/\"/&quot;/g; $_ },
         indent   => \&vmethod_indent,
         int      => sub { local $^W; int $_[0] },
         fmt      => \&vmethod_as_scalar,
         'format' => \&vmethod_format,
         hash     => sub { {value => $_[0]} },
         html     => sub { local $_ = $_[0]; s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g; s/\"/&quot;/g; $_ },

+        item     => sub { $_[0] },

         lcfirst  => sub { lcfirst $_[0] },
         length   => sub { defined($_[0]) ? length($_[0]) : 0 },
         list     => sub { [$_[0]] },
         lcfirst  => sub { lcfirst $_[0] },
         length   => sub { defined($_[0]) ? length($_[0]) : 0 },
         list     => sub { [$_[0]] },


@@ -81,11 +82,11 @@ BEGIN {
         remove   => sub { vmethod_replace(shift, shift, '', 1) },
         repeat   => \&vmethod_repeat,
         replace  => \&vmethod_replace,
         remove   => sub { vmethod_replace(shift, shift, '', 1) },
         repeat   => \&vmethod_repeat,
         replace  => \&vmethod_replace,

-        search   => sub { my ($str, $pat) = @_; return $str if ! defined $str || ! defined $pat; return scalar $str =~ /$pat/ },
+        search   => sub { my ($str, $pat) = @_; return $str if ! defined $str || ! defined $pat; return $str =~ /$pat/ },

         size     => sub { 1 },
         split    => \&vmethod_split,
         stderr   => sub { print STDERR $_[0]; '' },
         size     => sub { 1 },
         split    => \&vmethod_split,
         stderr   => sub { print STDERR $_[0]; '' },

-        substr   => sub { my ($str, $i, $len) = @_; defined($len) ? substr($str, $i, $len) : substr($str, $i) },
+        substr   => \&vmethod_substr,

         trim     => sub { local $_ = $_[0]; s/^\s+//; s/\s+$//; $_ },
         ucfirst  => sub { ucfirst $_[0] },
         upper    => sub { uc $_[0] },
         trim     => sub { local $_ = $_[0]; s/^\s+//; s/\s+$//; $_ },
         ucfirst  => sub { ucfirst $_[0] },
         upper    => sub { uc $_[0] },


@@ -101,46 +102,51 @@ BEGIN {
 
     $LIST_OPS = {
         as      => \&vmethod_as_list,
 
     $LIST_OPS = {
         as      => \&vmethod_as_list,

+        defined => sub { return 1 if @_ == 1; defined $_[0]->[ defined($_[1]) ? $_[1] : 0 ] },

         first   => sub { my ($ref, $i) = @_; return $ref->[0] if ! $i; return [@{$ref}[0 .. $i - 1]]},
         fmt     => \&vmethod_as_list,
         first   => sub { my ($ref, $i) = @_; return $ref->[0] if ! $i; return [@{$ref}[0 .. $i - 1]]},
         fmt     => \&vmethod_as_list,

-        grep    => sub { my ($ref, $pat) = @_; [grep {/$pat/} @$ref] },
-        hash    => sub { local $^W; my ($list, $i) = @_; defined($i) ? {map {$i++ => $_} @$list} : {@$list} },
+        grep    => sub { local $^W; my ($ref, $pat) = @_; [grep {/$pat/} @$ref] },
+        hash    => sub { local $^W; my $list = shift; return {@$list} if ! @_; my $i = shift || 0; return {map {$i++ => $_} @$list} },
+        import  => sub { my $ref = shift; push @$ref, grep {defined} map {ref eq 'ARRAY' ? @$_ : undef} @_; '' },
+        item    => sub { $_[0]->[ $_[1] || 0 ] },

         join    => sub { my ($ref, $join) = @_; $join = ' ' if ! defined $join; local $^W; return join $join, @$ref },
         last    => sub { my ($ref, $i) = @_; return $ref->[-1] if ! $i; return [@{$ref}[-$i .. -1]]},
         list    => sub { $_[0] },
         join    => sub { my ($ref, $join) = @_; $join = ' ' if ! defined $join; local $^W; return join $join, @$ref },
         last    => sub { my ($ref, $i) = @_; return $ref->[-1] if ! $i; return [@{$ref}[-$i .. -1]]},
         list    => sub { $_[0] },

-        max     => sub { $#{ $_[0] } },
+        max     => sub { local $^W; $#{ $_[0] } },

         merge   => sub { my $ref = shift; return [ @$ref, grep {defined} map {ref eq 'ARRAY' ? @$_ : undef} @_ ] },
         new     => sub { local $^W; return [@_] },
         merge   => sub { my $ref = shift; return [ @$ref, grep {defined} map {ref eq 'ARRAY' ? @$_ : undef} @_ ] },
         new     => sub { local $^W; return [@_] },

+        null    => sub { '' },

         nsort   => \&vmethod_nsort,
         pop     => sub { pop @{ $_[0] } },
         push    => sub { my $ref = shift; push @$ref, @_; return '' },
         random  => sub { my $ref = shift; $ref->[ rand @$ref ] },
         reverse => sub { [ reverse @{ $_[0] } ] },
         shift   => sub { shift  @{ $_[0] } },
         nsort   => \&vmethod_nsort,
         pop     => sub { pop @{ $_[0] } },
         push    => sub { my $ref = shift; push @$ref, @_; return '' },
         random  => sub { my $ref = shift; $ref->[ rand @$ref ] },
         reverse => sub { [ reverse @{ $_[0] } ] },
         shift   => sub { shift  @{ $_[0] } },

-        size    => sub { scalar @{ $_[0] } },
+        size    => sub { local $^W; scalar @{ $_[0] } },

         slice   => sub { my ($ref, $a, $b) = @_; $a ||= 0; $b = $#$ref if ! defined $b; return [@{$ref}[$a .. $b]] },
         sort    => \&vmethod_sort,
         splice  => \&vmethod_splice,
         slice   => sub { my ($ref, $a, $b) = @_; $a ||= 0; $b = $#$ref if ! defined $b; return [@{$ref}[$a .. $b]] },
         sort    => \&vmethod_sort,
         splice  => \&vmethod_splice,

-        unique  => sub { my %u; return [ grep { ! $u{$_} ++ } @{ $_[0] } ] },
+        unique  => sub { my %u; return [ grep { ! $u{$_}++ } @{ $_[0] } ] },

         unshift => sub { my $ref = shift; unshift @$ref, @_; return '' },
     };
 
     $HASH_OPS = {
         as      => \&vmethod_as_hash,
         unshift => sub { my $ref = shift; unshift @$ref, @_; return '' },
     };
 
     $HASH_OPS = {
         as      => \&vmethod_as_hash,

-        defined => sub { return '' if ! defined $_[1]; defined $_[0]->{ $_[1] } },
-        delete  => sub { return '' if ! defined $_[1]; delete  $_[0]->{ $_[1] } },
+        defined => sub { return 1 if @_ == 1; defined $_[0]->{ defined($_[1]) ? $_[1] : '' } },
+        delete  => sub { my $h = shift; my @v = delete @{ $h }{map {defined($_) ? $_ : ''} @_}; @_ == 1 ? $v[0] : \@v },

         each    => sub { [%{ $_[0] }] },
         each    => sub { [%{ $_[0] }] },

-        exists  => sub { return '' if ! defined $_[1]; exists $_[0]->{ $_[1] } },
+        exists  => sub { exists $_[0]->{ defined($_[1]) ? $_[1] : '' } },

         fmt     => \&vmethod_as_hash,
         hash    => sub { $_[0] },
         fmt     => \&vmethod_as_hash,
         hash    => sub { $_[0] },

-        import  => sub { my ($a, $b) = @_; return '' if ref($b) ne 'HASH'; @{$a}{keys %$b} = values %$b; '' },
-        item    => sub { my ($h, $k) = @_; return '' if ! defined $k || $k =~ $QR_PRIVATE; $h->{$k} },
+        import  => sub { my ($a, $b) = @_; @{$a}{keys %$b} = values %$b if ref($b) eq 'HASH'; '' },
+        item    => sub { my ($h, $k) = @_; $k = '' if ! defined $k; $k =~ $QR_PRIVATE ? undef : $h->{$k} },

         items   => sub { [ %{ $_[0] } ] },
         keys    => sub { [keys %{ $_[0] }] },
         items   => sub { [ %{ $_[0] } ] },
         keys    => sub { [keys %{ $_[0] }] },

-        list    => sub { [$_[0]] },
+        list    => \&vmethod_list_hash,

         new     => sub { local $^W; return (@_ == 1 && ref $_[-1] eq 'HASH') ? $_[-1] : {@_} },
         new     => sub { local $^W; return (@_ == 1 && ref $_[-1] eq 'HASH') ? $_[-1] : {@_} },

-        nsort   => sub { my $ref = shift; [sort {$ref->{$a}    <=> $ref->{$b}   } keys %$ref] },
-        pairs   => sub { [map { {key => $_, value => $_[0]->{$_}} } keys %{ $_[0] } ] },
+        null    => sub { '' },
+        nsort   => sub { my $ref = shift; [sort {   $ref->{$a} <=>    $ref->{$b}} keys %$ref] },
+        pairs   => sub { [map { {key => $_, value => $_[0]->{$_}} } sort keys %{ $_[0] } ] },

         size    => sub { scalar keys %{ $_[0] } },
         sort    => sub { my $ref = shift; [sort {lc $ref->{$a} cmp lc $ref->{$b}} keys %$ref] },
         values  => sub { [values %{ $_[0] }] },
         size    => sub { scalar keys %{ $_[0] } },
         sort    => sub { my $ref = shift; [sort {lc $ref->{$a} cmp lc $ref->{$b}} keys %$ref] },
         values  => sub { [values %{ $_[0] }] },


@@ -2910,11 +2916,18 @@ sub vmethod_format {
     }
 }
 
     }
 }
 

+sub vmethod_list_hash {
+    my ($hash, $what) = @_;
+    $what = 'pairs' if ! $what || $what !~ /^(keys|values|each|pairs)$/;
+    return $HASH_OPS->{$what}->($hash);
+}
+
+

 sub vmethod_match {
     my ($str, $pat, $global) = @_;
     return [] if ! defined $str || ! defined $pat;
     my @res = $global ? ($str =~ /$pat/g) : ($str =~ /$pat/);
 sub vmethod_match {
     my ($str, $pat, $global) = @_;
     return [] if ! defined $str || ! defined $pat;
     my @res = $global ? ($str =~ /$pat/g) : ($str =~ /$pat/);

-    return (@res >= 2) ? \@res : (@res == 1) ? $res[0] : '';
+    return @res ? \@res : '';

 }
 
 sub vmethod_nsort {
 }
 
 sub vmethod_nsort {


@@ -2928,7 +2941,7 @@ sub vmethod_nsort {
 
 sub vmethod_repeat {
     my ($str, $n, $join) = @_;
 
 sub vmethod_repeat {
     my ($str, $n, $join) = @_;

-    return if ! length $str;
+    return '' if ! defined $str || ! length $str;

     $n = 1 if ! defined($n) || ! length $n;
     $join = '' if ! defined $join;
     return join $join, ($str) x $n;
     $n = 1 if ! defined($n) || ! length $n;
     $join = '' if ! defined $join;
     return join $join, ($str) x $n;


@@ -2973,15 +2986,27 @@ sub vmethod_splice {
     @replace = @{ $replace[0] } if @replace == 1 && ref $replace[0] eq 'ARRAY';
     if (defined $len) {
         return [splice @$ref, $i || 0, $len, @replace];
     @replace = @{ $replace[0] } if @replace == 1 && ref $replace[0] eq 'ARRAY';
     if (defined $len) {
         return [splice @$ref, $i || 0, $len, @replace];

+    } elsif (defined $i) {
+        return [splice @$ref, $i];

     } else {
     } else {

-        return [splice @$ref, $i || 0];
+        return [splice @$ref];

     }
 }
 
 sub vmethod_split {
     }
 }
 
 sub vmethod_split {

-    my ($str, $pat, @args) = @_;
+    my ($str, $pat, $lim) = @_;

     $str = '' if ! defined $str;
     $str = '' if ! defined $str;

-    return defined $pat ? [split $pat, $str, @args] : [split ' ', $str, @args];
+    if (defined $lim) { return defined $pat ? [split $pat, $str, $lim] : [split ' ', $str, $lim] }
+    else              { return defined $pat ? [split $pat, $str      ] : [split ' ', $str      ] }
+}
+
+sub vmethod_substr {
+    my ($str, $i, $len, $replace) = @_;
+    $i ||= 0;
+    return substr($str, $i)       if ! defined $len;
+    return substr($str, $i, $len) if ! defined $replace;
+    substr($str, $i, $len, $replace);
+    return $str;

 }
 
 sub vmethod_uri {
 }
 
 sub vmethod_uri {

diff --git a/lib/CGI/Ex/Validate.pm b/lib/CGI/Ex/Validate.pm
index 5bb62e3f362c97540e66bfcaf4c60db2a4d797d6..6b8401445b99189d35096551e053f321bbf9bfd1 100644 (file)
--- a/lib/CGI/Ex/Validate.pm
+++ b/lib/CGI/Ex/Validate.pm
@@ -22,7 +22,7 @@ use vars qw($VERSION
             @UNSUPPORTED_BROWSERS
             );
 
             @UNSUPPORTED_BROWSERS
             );
 

-$VERSION = '2.08';
+$VERSION = '2.09';

 
 $DEFAULT_EXT   = 'val';
 $QR_EXTRA      = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;
 
 $DEFAULT_EXT   = 'val';
 $QR_EXTRA      = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;

diff --git a/t/7_template_00_base.t b/t/7_template_00_base.t
index c1b17ba0917856449130348e78581fc744109afd..54adcd9c02d3294281160e43237fa555a0dfd530 100644 (file)
--- a/t/7_template_00_base.t
+++ b/t/7_template_00_base.t
@@ -8,13 +8,13 @@
 
 use vars qw($module $is_tt);
 BEGIN {
 
 use vars qw($module $is_tt);
 BEGIN {

-    $module = 'CGI::Ex::Template'; #real    0m1.243s #user    0m0.695s #sys     0m0.018s
-    #$module = 'Template';         #real    0m2.329s #user    0m1.466s #sys     0m0.021s
+    $module = 'CGI::Ex::Template'; #real    0m1.113s #user    0m0.416s #sys     0m0.016s
+#    $module = 'Template';         #real    0m3.022s #user    0m1.168s #sys     0m0.024s

     $is_tt = $module eq 'Template';
 };
 
 use strict;
     $is_tt = $module eq 'Template';
 };
 
 use strict;

-use Test::More tests => 521 - ($is_tt ? 109 : 0);
+use Test::More tests => ! $is_tt ? 662 : 519;

 use Data::Dumper qw(Dumper);
 use constant test_taint => 0 && eval { require Taint::Runtime };
 
 use Data::Dumper qw(Dumper);
 use constant test_taint => 0 && eval { require Taint::Runtime };
 


@@ -296,7 +296,171 @@ process_ok("[% CALL foo %]" => '',   {foo => sub {$t++; 'hi'}});
 ok($t == 3, "CALL method actually called var");
 
 ###----------------------------------------------------------------###
 ok($t == 3, "CALL method actually called var");
 
 ###----------------------------------------------------------------###

-### virtual methods / filters
+### virtual method tests
+
+# scalar vmethods
+process_ok("[% n.0 %]" => '7', {n => 7}) if ! $is_tt;
+process_ok("[% n.as %]" => '7', {n => 7}) if ! $is_tt;
+process_ok("[% n.as('%02d') %]" => '07', {n => 7}) if ! $is_tt;
+process_ok("[% n.as('%0*d', 3) %]" => '007', {n => 7}) if ! $is_tt;
+process_ok("[% n.as('(%s)') %]" => "(a\nb)", {n => "a\nb"}) if ! $is_tt;
+process_ok("[% n.chunk(3).join %]" => 'abc def g', {n => 'abcdefg'});
+process_ok("[% n.chunk(-3).join %]" => 'a bcd efg', {n => 'abcdefg'});
+process_ok("[% n|collapse %]" => "a b", {n => '  a  b  '}); # TT2 filter
+process_ok("[% n.defined %]" => "1", {n => ''});
+process_ok("[% n.defined %]" => "", {n => undef});
+process_ok("[% n.defined %]" => "1", {n => '1'});
+process_ok("[% n|indent %]" => "    a\n    b", {n => "a\nb"}); # TT2 filter
+process_ok("[% n|indent(2) %]" => "  a\n  b", {n => "a\nb"}); # TT2 filter
+process_ok("[% n|indent('wow ') %]" => "wow a\nwow b", {n => "a\nb"}); # TT2 filter
+process_ok("[% n.int %]" => "123", {n => "123.234"}) if ! $is_tt;
+process_ok("[% n.int %]" => "123", {n => "123gggg"}) if ! $is_tt;
+process_ok("[% n.int %]" => "0", {n => "ff123.234"}) if ! $is_tt;
+process_ok("[% n.fmt('%02d') %]" => '07', {n => 7}) if ! $is_tt;
+process_ok("[% n.fmt('%0*d', 3) %]" => '007', {n => 7}) if ! $is_tt;
+process_ok("[% n.fmt('(%s)') %]" => "(a\nb)", {n => "a\nb"}) if ! $is_tt;
+process_ok("[% n|format('%02d') %]" => '07', {n => 7}); # TT2 filter
+process_ok("[% n.format('%0*d', 3) %]" => '007', {n => 7}) if ! $is_tt;
+process_ok("[% n|format('(%s)') %]" => "(a)\n(b)", {n => "a\nb"}); # TT2 filter
+process_ok("[% n.hash.items.1 %]" => "b", {n => {a => "b"}});
+process_ok("[% n|html %]" => "&", {n => '&'}); # TT2 filter
+process_ok("[% n.item %]" => '7', {n => 7});
+process_ok("[% n|lcfirst %]" => 'fOO', {n => "FOO"}); # TT2 filter
+process_ok("[% n.length %]" => 3, {n => "abc"});
+process_ok("[% n.list.0 %]" => 'abc', {n => "abc"});
+process_ok("[% n|lower %]" => 'abc', {n => "ABC"}); # TT2 filter
+process_ok("[% n.match('foo').join %]" => '', {n => "bar"});
+process_ok("[% n.match('foo').join %]" => '1', {n => "foo"});
+process_ok("[% n.match('foo',1).join %]" => 'foo', {n => "foo"});
+process_ok("[% n.match('(foo)').join %]" => 'foo', {n => "foo"});
+process_ok("[% n.match('(foo)').join %]" => 'foo', {n => "foofoo"});
+process_ok("[% n.match('(foo)',1).join %]" => 'foo foo', {n => "foofoo"});
+process_ok("[% n.null %]" => '', {n => "abc"});
+process_ok("[% n.rand %]" => qr{^\d+\.\d+}, {n => "2"}) if ! $is_tt;
+process_ok("[% n.rand %]" => qr{^\d+\.\d+}, {n => "ab"}) if ! $is_tt;
+process_ok("[% n.remove('bc') %]" => "a", {n => "abc"});
+process_ok("[% n.remove('bc') %]" => "aa", {n => "abcabc"});
+process_ok("[% n.repeat %]" => '1',     {n => 1}) if ! $is_tt; # tt2 virtual method defaults to 0
+process_ok("[% n.repeat(0) %]" => '',   {n => 1});
+process_ok("[% n.repeat(1) %]" => '1',  {n => 1});
+process_ok("[% n.repeat(2) %]" => '11', {n => 1});
+process_ok("[% n.repeat(2,'|') %]" => '1|1', {n => 1}) if ! $is_tt;
+process_ok("[% n.replace('foo', 'bar') %]" => 'barbar', {n => 'foofoo'});
+process_ok("[% n.replace('(foo)', 'bar\$1') %]" => 'barfoobarfoo', {n => 'foofoo'}) if ! $is_tt;
+process_ok("[% n.replace('foo', 'bar', 0) %]" => 'barfoo', {n => 'foofoo'}) if ! $is_tt;
+process_ok("[% n.search('foo') %]" => '', {n => "bar"});
+process_ok("[% n.search('foo') %]" => '1', {n => "foo"});
+process_ok("[% n.size %]" => '1', {n => "foo"});
+process_ok("[% n.split.join('|') %]" => "abc", {n => "abc"});
+process_ok("[% n.split.join('|') %]" => "a|b|c", {n => "a b c"});
+process_ok("[% n.split.join('|') %]" => "a|b|c", {n => "a b c"});
+process_ok("[% n.split(u,2).join('|') %]" => "a|b c", {n => "a b c", u => undef}) if ! $is_tt;
+process_ok("[% n.split(u,2).join('|') %]" => "a| b c", {n => "a b c", u => undef}) if $is_tt;
+process_ok("[% n.split('/').join('|') %]" => "a|b|c", {n => "a/b/c"});
+process_ok("[% n.split('/', 2).join('|') %]" => "a|b/c", {n => "a/b/c"});
+process_ok("[% n.stderr %]" => "", {n => "# testing stderr ... ok\n"});
+process_ok("[% n|trim %]" => "a  b", {n => '  a  b  '}); # TT2 filter
+process_ok("[% n|ucfirst %]" => 'Foo', {n => "foo"}); # TT2 filter
+process_ok("[% n|upper %]" => 'FOO', {n => "foo"}); # TT2 filter
+process_ok("[% n|uri %]" => 'a%20b', {n => "a b"}); # TT2 filter
+
+# list vmethods
+process_ok("[% a.as %]" => '2 3', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.as('%02d') %]" => '02 03', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.as('%02d',' ') %]" => '02 03', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.as('%02d','|') %]" => '02|03', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.as('%0*d','|', 3) %]" => '002|003', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.defined %]" => '1', {a => [2,3]});
+process_ok("[% a.defined(1) %]" => '1', {a => [2,3]});
+process_ok("[% a.defined(3) %]" => '', {a => [2,3]});
+process_ok("[% a.first %]" => '2', {a => [2..10]});
+process_ok("[% a.first(3).join %]" => '2 3 4', {a => [2..10]});
+process_ok("[% a.fmt('%02d',' ') %]" => '02 03', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.fmt('%02d','|') %]" => '02|03', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.fmt('%0*d','|', 3) %]" => '002|003', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.grep.join %]" => '2 3', {a => [2,3]});
+process_ok("[% a.grep(2).join %]" => '2', {a => [2,3]});
+process_ok("[% a.hash.items.join %]" => '2 3', {a => [2,3]});
+process_ok("[% a.hash(5).items.sort.join %]" => '2 3 5 6', {a => [2,3]});
+process_ok("[% a.import(5) %]|[% a.join %]" => '|2 3', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.import(5) %]|[% a.join %]" => qr{^ARRAY.+|2 3$ }x, {a => [2,3]}) if $is_tt;
+process_ok("[% a.import([5]) %]|[% a.join %]" => '|2 3 5', {a => [2,3]}) if ! $is_tt;
+process_ok("[% a.import([5]) %]|[% a.join %]" => qr{ARRAY.+|2 3 5$ }x, {a => [2,3]}) if $is_tt;
+process_ok("[% a.item %]" => '2', {a => [2,3]});
+process_ok("[% a.item(1) %]" => '3', {a => [2,3]});
+process_ok("[% a.join %]" => '2 3', {a => [2,3]});
+process_ok("[% a.join('|') %]" => '2|3', {a => [2,3]});
+process_ok("[% a.last %]" => '10', {a => [2..10]});
+process_ok("[% a.last(3).join %]" => '8 9 10', {a => [2..10]});
+process_ok("[% a.list.join %]" => '2 3', {a => [2, 3]});
+process_ok("[% a.max %]" => '1', {a => [2, 3]});
+process_ok("[% a.merge(5).join %]" => '2 3', {a => [2,3]});
+process_ok("[% a.merge([5]).join %]" => '2 3 5', {a => [2,3]});
+process_ok("[% a.merge([5]).null %][% a.join %]" => '2 3', {a => [2,3]});
+process_ok("[% a.nsort.join %]" => '1 2 3', {a => [2, 3, 1]});
+process_ok("[% a.nsort('b').0.b %]" => '7', {a => [{b => 23}, {b => 7}]});
+process_ok("[% a.pop %][% a.join %]" => '32', {a => [2, 3]});
+process_ok("[% a.push(3) %][% a.join %]" => '2 3 3', {a => [2, 3]});
+process_ok("[% a.random %]" => qr{ ^\d$ }x, {a => [2, 3]}) if ! $is_tt;
+process_ok("[% a.reverse.join %]" => '3 2', {a => [2, 3]});
+process_ok("[% a.shift %][% a.join %]" => '23', {a => [2, 3]});
+process_ok("[% a.size %]" => '2', {a => [2, 3]});
+process_ok("[% a.slice.join %]" => '2 3 4 5', {a => [2..5]});
+process_ok("[% a.slice(2).join %]" => '4 5', {a => [2..5]});
+process_ok("[% a.slice(0,2).join %]" => '2 3 4', {a => [2..5]});
+process_ok("[% a.sort.join %]" => '1 2 3', {a => [2, 3, 1]});
+process_ok("[% a.sort('b').0.b %]" => 'wee', {a => [{b => "wow"}, {b => "wee"}]});
+process_ok("[% a.splice.join %]|[% a.join %]" => '2 3 4 5|', {a => [2..5]});
+process_ok("[% a.splice(2).join %]|[% a.join %]" => '4 5|2 3', {a => [2..5]});
+process_ok("[% a.splice(0,2).join %]|[% a.join %]" => '2 3|4 5', {a => [2..5]});
+process_ok("[% a.splice(0,2,'hrm').join %]|[% a.join %]" => '2 3|hrm 4 5', {a => [2..5]});
+process_ok("[% a.unique.join %]" => '2 3', {a => [2,3,3,3,2]});
+process_ok("[% a.unshift(3) %][% a.join %]" => '3 2 3', {a => [2, 3]});
+
+# hash vmethods
+process_ok("[% h.as %]" => "b\tB\nc\tC", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.as('%s => %s') %]" => "b => B\nc => C", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.as('%s => %s', '|') %]" => "b => B|c => C", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.as('%*s=>%s', '|', 3) %]" => "  b=>B|  c=>C", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.as('%*s=>%*s', '|', 3, 4) %]" => "  b=>   B|  c=>   C", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.defined %]" => "1", {h => {}});
+process_ok("[% h.defined('a') %]" => "1", {h => {a => 1}});
+process_ok("[% h.defined('b') %]" => "", {h => {a => 1}});
+process_ok("[% h.defined('a') %]" => "", {h => {a => undef}});
+process_ok("[% h.delete('a') %]|[% h.keys.0 %]" => "1|b", {h => {a => 1, b=> 2}}) if ! $is_tt;
+process_ok("[% h.delete('a') %]|[% h.keys.0 %]" => "|b", {h => {a => 1, b=> 2}}) if $is_tt;
+process_ok("[% h.delete('a', 'b').join %]|[% h.keys.0 %]" => "1 2|", {h => {a => 1, b=> 2}}) if ! $is_tt;
+process_ok("[% h.delete('a', 'b').join %]|[% h.keys.0 %]" => "|", {h => {a => 1, b=> 2}}) if $is_tt;
+process_ok("[% h.delete('a', 'c').join %]|[% h.keys.0 %]" => "1 |b", {h => {a => 1, b=> 2}}) if ! $is_tt;
+process_ok("[% h.delete('a', 'c').join %]|[% h.keys.0 %]" => "|b", {h => {a => 1, b=> 2}}) if $is_tt;
+process_ok("[% h.each.sort.join %]" => "1 2 a b", {h => {a => 1, b=> 2}});
+process_ok("[% h.exists('a') %]" => "1", {h => {a => 1}});
+process_ok("[% h.exists('b') %]" => "", {h => {a => 1}});
+process_ok("[% h.exists('a') %]" => "1", {h => {a => undef}});
+process_ok("[% h.fmt('%s => %s') %]" => "b => B\nc => C", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.fmt('%s => %s', '|') %]" => "b => B|c => C", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.fmt('%*s=>%s', '|', 3) %]" => "  b=>B|  c=>C", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.fmt('%*s=>%*s', '|', 3, 4) %]" => "  b=>   B|  c=>   C", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.hash.fmt %]" => "b\tB\nc\tC", {h => {b => "B", c => "C"}}) if ! $is_tt;
+process_ok("[% h.import('a') %]|[% h.items.sort.join %]" => "|b B c C", {h => {b => "B", c => "C"}});
+process_ok("[% h.import({'b' => 'boo'}) %]|[% h.items.sort.join %]" => "|b boo c C", {h => {b => "B", c => "C"}});
+process_ok("[% h.item('a') %]" => 'A', {h => {a => 'A'}});
+process_ok("[% h.item('_a') %]" => '', {h => {_a => 'A'}}) if ! $is_tt;
+process_ok("[% h.items.sort.join %]" => "1 2 a b", {h => {a => 1, b=> 2}});
+process_ok("[% h.keys.sort.join %]" => "a b", {h => {a => 1, b=> 2}});
+process_ok("[% h.list('each').sort.join %]" => "1 2 a b", {h => {a => 1, b=> 2}});
+process_ok("[% h.list('keys').sort.join %]" => "a b", {h => {a => 1, b=> 2}});
+process_ok("[% h.list('pairs').0.items.sort.join %]" => "1 a key value", {h => {a => 1, b=> 2}});
+process_ok("[% h.list('values').sort.join %]" => "1 2", {h => {a => 1, b=> 2}});
+process_ok("[% h.null %]" => "", {h => {}});
+process_ok("[% h.nsort.join %]" => "b a", {h => {a => 7, b => 2}});
+process_ok("[% h.pairs.0.items.sort.join %]" => "1 a key value", {h => {a => 1, b=> 2}});
+process_ok("[% h.size %]" => "2", {h => {a => 1, b=> 2}});
+process_ok("[% h.sort.join %]" => "b a", {h => {a => "BBB", b => "A"}});
+process_ok("[% h.values.sort.join %]" => "1 2", {h => {a => 1, b=> 2}});
+
+###----------------------------------------------------------------###
+### more virtual methods / filters

 
 process_ok("[% [0 .. 10].reverse.1 %]" => 9) if ! $is_tt;
 process_ok("[% {a => 'A'}.a %]" => 'A') if ! $is_tt;
 
 process_ok("[% [0 .. 10].reverse.1 %]" => 9) if ! $is_tt;
 process_ok("[% {a => 'A'}.a %]" => 'A') if ! $is_tt;


@@ -308,21 +472,12 @@ process_ok("[% (-123.2).length %]" => 6) if ! $is_tt;
 process_ok("[% a = 23; a.0 %]" => 23) if ! $is_tt; # '0' is a scalar_op
 process_ok('[% 1.rand %]' => qr/^0\.\d+(?:e-?\d+)?$/) if ! $is_tt;
 
 process_ok("[% a = 23; a.0 %]" => 23) if ! $is_tt; # '0' is a scalar_op
 process_ok('[% 1.rand %]' => qr/^0\.\d+(?:e-?\d+)?$/) if ! $is_tt;
 

-process_ok("[% n.repeat %]" => '1',     {n => 1}) if ! $is_tt; # tt2 virtual method defaults to 0
-process_ok("[% n.repeat(0) %]" => '',   {n => 1});
-process_ok("[% n.repeat(1) %]" => '1',  {n => 1});
-process_ok("[% n.repeat(2) %]" => '11', {n => 1});
-process_ok("[% n.repeat(2,'|') %]" => '1|1', {n => 1}) if ! $is_tt;
-

 process_ok("[% n.size %]", => 'SIZE', {n => {size => 'SIZE', a => 'A'}});
 process_ok("[% n|size %]", => '2',    {n => {size => 'SIZE', a => 'A'}}) if ! $is_tt; # tt2 | is alias for FILTER
 
 process_ok('[% foo | eval %]' => 'baz', {foo => '[% bar %]', bar => 'baz'});
 process_ok('[% "1" | indent(2) %]' => '  1');
 
 process_ok("[% n.size %]", => 'SIZE', {n => {size => 'SIZE', a => 'A'}});
 process_ok("[% n|size %]", => '2',    {n => {size => 'SIZE', a => 'A'}}) if ! $is_tt; # tt2 | is alias for FILTER
 
 process_ok('[% foo | eval %]' => 'baz', {foo => '[% bar %]', bar => 'baz'});
 process_ok('[% "1" | indent(2) %]' => '  1');
 

-process_ok("[% n.replace('foo', 'bar') %]" => 'barbar', {n => 'foofoo'});
-process_ok("[% n.replace('(foo)', 'bar\$1') %]" => 'barfoobarfoo', {n => 'foofoo'}) if ! $is_tt;
-process_ok("[% n.replace('foo', 'bar', 0) %]" => 'barfoo', {n => 'foofoo'}) if ! $is_tt;

 
 process_ok("[% n FILTER size %]", => '1', {n => {size => 'SIZE', a => 'A'}}) if ! $is_tt; # tt2 doesn't have size
 
 
 process_ok("[% n FILTER size %]", => '1', {n => {size => 'SIZE', a => 'A'}}) if ! $is_tt; # tt2 doesn't have size