From b6e904ff7b346908d0662aae9a9c5f7d976dd85e Mon Sep 17 00:00:00 2001 From: Paul Seamons Date: Tue, 26 Jun 2007 00:00:00 +0000 Subject: [PATCH] CGI::Ex 2.17 --- Changes | 8 ++ META.yml | 2 +- README | 8 ++ lib/CGI/Ex.pm | 13 ++- lib/CGI/Ex/App.pm | 101 ++++++++++++++++++---- lib/CGI/Ex/App.pod | 187 +++++++++++++++++++++++++++++++---------- lib/CGI/Ex/Auth.pm | 2 +- lib/CGI/Ex/Conf.pm | 4 +- lib/CGI/Ex/Die.pm | 2 +- lib/CGI/Ex/Dump.pm | 2 +- lib/CGI/Ex/Fill.pm | 2 +- lib/CGI/Ex/JSONDump.pm | 2 +- lib/CGI/Ex/Template.pm | 2 +- lib/CGI/Ex/Validate.pm | 2 +- t/0_ex_00_base.t | 52 +++++++++++- t/4_app_00_base.t | 48 +++++++++-- 16 files changed, 357 insertions(+), 80 deletions(-) diff --git a/Changes b/Changes index 334aab4..f13b758 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,11 @@ +2.17 + 2007-06-26 + * Add load_conf and conf* methods to App to allow for easier external configuration + * Add more documentation + * Allow print_content_type('text/html', 'utf-8') + * Allow App to pass mimetime and charset to print_out. + * Update path methods. + 2.16 2007-06-21 * Add default __error step which is called by default handle_error method. diff --git a/META.yml b/META.yml index 6b82f0c..53b67de 100644 --- 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 -version: 2.16 +version: 2.17 version_from: lib/CGI/Ex.pm installdirs: site requires: diff --git a/README b/README index fcafd52..1553dbf 100644 --- a/README +++ b/README @@ -223,6 +223,14 @@ CGI::Ex METHODS header. Trying to print ->content_type is an error. For clarity, the method ->print_content_type is available. + $cgix->print_content_type; + + # OR + $cgix->print_content_type('text/html'); + + # OR + $cgix->print_content_type('text/html', 'utf-8'); + "->set_cookie" Arguments are the same as those to CGI->new->cookie({}). Uses CGI's cookie method to create a cookie, but then, depending on if content diff --git a/lib/CGI/Ex.pm b/lib/CGI/Ex.pm index ed1b511..4b3b8a8 100644 --- a/lib/CGI/Ex.pm +++ b/lib/CGI/Ex.pm @@ -24,7 +24,7 @@ use vars qw($VERSION use base qw(Exporter); BEGIN { - $VERSION = '2.16'; + $VERSION = '2.17'; $PREFERRED_CGI_MODULE ||= 'CGI'; @EXPORT = (); @EXPORT_OK = qw(get_form @@ -249,7 +249,7 @@ sub content_type { &print_content_type } # print_content_type(); # print_content_type('text/plain); sub print_content_type { - my ($self, $type) = ($#_ >= 1) ? @_ : ref($_[0]) ? (shift, undef) : (undef, shift); + my ($self, $type, $charset) = (@_ && ref $_[0]) ? @_ : (undef, @_); $self = __PACKAGE__->new if ! $self; if ($type) { @@ -257,6 +257,7 @@ sub print_content_type { } else { $type = 'text/html'; } + $type .= "; charset=$charset" if $charset && $charset =~ m|^[\w\-\.\:\+]+$|; if (my $r = $self->apache_request) { return if $r->bytes_sent; @@ -920,6 +921,14 @@ else already printed content-type). Calling this sends the Content-type header. Trying to print -Econtent_type is an error. For clarity, the method -Eprint_content_type is available. + $cgix->print_content_type; + + # OR + $cgix->print_content_type('text/html'); + + # OR + $cgix->print_content_type('text/html', 'utf-8'); + =item C<-Eset_cookie> Arguments are the same as those to CGI->new->cookie({}). diff --git a/lib/CGI/Ex/App.pm b/lib/CGI/Ex/App.pm index 2c7ecee..c44d716 100644 --- a/lib/CGI/Ex/App.pm +++ b/lib/CGI/Ex/App.pm @@ -10,7 +10,7 @@ use strict; use vars qw($VERSION); BEGIN { - $VERSION = '2.16'; + $VERSION = '2.17'; Time::HiRes->import('time') if eval {require Time::HiRes}; eval {require Scalar::Util}; @@ -33,6 +33,8 @@ sub new { $self->init; + $self->init_from_conf; + return $self; } @@ -42,6 +44,65 @@ sub destroy {} ###----------------------------------------------------------------### +sub init_from_conf { + my $self = shift; + return if ! $self->load_conf; + my $conf = $self->conf; + @{ $self }{ keys %$conf } = values %$conf; + return; +} + +sub load_conf { shift->{'load_conf'} ||= @_ ? 1 : 0 } + +sub conf { + my $self = shift; + return $self->{'conf'} ||= do { + my $conf = $self->conf_obj->read($self->conf_file, {no_warn_on_fail => 1}) || croak $@; + my $hash = $self->conf_validation; + if ($hash && scalar keys %$hash) { + my $err_obj = $self->vob->validate($conf, $hash); + die $err_obj if $err_obj; + } + $conf; + } +} + +sub conf_path { + my $self = shift; + return $self->{'conf_path'} || $self->base_dir_abs; +} + +sub conf_file { + my $self = shift; + return $self->{'conf_file'} ||= do { + my $module = $self->name_module || croak 'Missing name_module during conf_file call'; + $module .'.'. $self->conf_ext; + }; +} + +sub conf_ext { + my $self = shift; + $self->{'conf_ext'} = shift if @_ == 1; + return $self->{'conf_ext'} || 'pl'; +} + +sub conf_args { shift->{'conf_args'} || {} } + +sub conf_obj { + my $self = shift; + return $self->{'conf_obj'} || do { + my $args = $self->conf_args; + $args->{'paths'} ||= $self->conf_path; + $args->{'directive'} ||= 'MERGE'; + require CGI::Ex::Conf; + CGI::Ex::Conf->new($args); + }; +} + +sub conf_validation {} + +###----------------------------------------------------------------### + sub navigate { my ($self, $args) = @_; $self = $self->new($args) if ! ref $self; @@ -710,15 +771,17 @@ sub vob { $self->{'vob'} = shift if @_ == 1; return $self->{'vob'} ||= do { require CGI::Ex::Validate; + my $args = $self->vob_args; + $args->{'cgix'} ||= $self->cgix; CGI::Ex::Validate->new($self->vob_args); # return of the do }; } -sub vob_args { +sub vob_args { shift->{'vob_args'} || {} } + +sub vob_path { my $self = shift; - return { - cgix => $self->cgix, - }; + return $self->{'vob_path'} || $self->template_path; } ### provide a place for placing variables @@ -825,7 +888,7 @@ sub prepared_print { sub print { my ($self, $step, $swap, $fill) = @_; - my $file = $self->run_hook('file_print', $step); # get a filename relative to base_dir_abs + my $file = $self->run_hook('file_print', $step); # get a filename relative to template_path my $out = $self->run_hook('swap_template', $step, $file, $swap); $self->run_hook('fill_template', $step, \$out, $fill); $self->run_hook('print_out', $step, \$out); @@ -834,15 +897,18 @@ sub print { sub print_out { my ($self, $step, $out) = @_; - $self->cgix->print_content_type; + $self->cgix->print_content_type($self->mimetype($step), $self->charset($step)); print ref($out) eq 'SCALAR' ? $$out : $out; } +sub mimetype { shift->{'mimetype'} || 'text/html' } +sub charset { shift->{'charset'} || '' } + sub swap_template { my ($self, $step, $file, $swap) = @_; my $args = $self->run_hook('template_args', $step); - $args->{'INCLUDE_PATH'} ||= $self->base_dir_abs; + $args->{'INCLUDE_PATH'} ||= $args->{'include_path'} || $self->template_path; my $t = $self->template_obj($args); my $out = ''; @@ -851,7 +917,12 @@ sub swap_template { return $out; } -sub template_args { {} } +sub template_path { + my $self = shift; + return $self->{'template_path'} || $self->base_dir_abs; +} + +sub template_args { shift->{'template_args'} || {} } sub template_obj { my ($self, $args) = @_; @@ -873,7 +944,7 @@ sub fill_template { CGI::Ex::Fill::fill($args); } -sub fill_args { {} } +sub fill_args { shift->{'fill_args'} || {} } sub pre_step { 0 } # success indicates we handled step (don't continue step or loop) sub skip { 0 } # success indicates to skip the step (and continue loop) @@ -927,7 +998,7 @@ sub file_val { my $step = shift; ### determine the path to begin looking for files - allow for an arrayref - my $abs = $self->base_dir_abs || []; + my $abs = $self->vob_path || []; $abs = $abs->() if UNIVERSAL::isa($abs, 'CODE'); $abs = [$abs] if ! UNIVERSAL::isa($abs, 'ARRAY'); return {} if @$abs == 0; @@ -1046,10 +1117,10 @@ sub hash_base { my $copy = $self; eval {require Scalar::Util; Scalar::Util::weaken($copy)}; my $hash = { - script_name => $copy->script_name, - path_info => $copy->path_info, + script_name => $self->script_name, + path_info => $self->path_info, js_validation => sub { $copy->run_hook('js_validation', $step, shift) }, - form_name => sub { $copy->run_hook('form_name', $step) }, + form_name => $self->run_hook('form_name', $step), $self->step_key => $step, }; # return of the do }; @@ -1172,7 +1243,7 @@ sub __error_info_complete { 0 } sub __error_hash_swap { shift->stash } -sub __error_file_print { \ "

An a fatal error occurred

Step: \"[% error_step %]\"
[% TRY; CONFIG DUMP => {header => 0}; DUMP error; END %]" } +sub __error_file_print { \ "

A fatal error occurred

Step: \"[% error_step %]\"
[% TRY; CONFIG DUMP => {header => 0}; DUMP error; END %]" } ###----------------------------------------------------------------### diff --git a/lib/CGI/Ex/App.pod b/lib/CGI/Ex/App.pod index 3b93a78..59c5e21 100644 --- a/lib/CGI/Ex/App.pod +++ b/lib/CGI/Ex/App.pod @@ -31,7 +31,7 @@ Well, you should put your content in an external file... __PACKAGE__->navigate; - sub base_dir_abs { '/var/www/templates' } + sub template_path { '/var/www/templates' } -------- File: /var/www/templates/my_cgi/main.html -------- @@ -49,7 +49,7 @@ How about if we want to add substitutions... __PACKAGE__->navigate; - sub base_dir_abs { '/var/www/templates' } + sub template_path { '/var/www/templates' } sub main_hash_swap { my $self = shift; @@ -76,7 +76,7 @@ How about a form with validation (inluding javascript validation)... __PACKAGE__->navigate; - sub base_dir_abs { '/var/www/templates' } + sub template_path { '/var/www/templates' } sub main_hash_swap { {date => sub { scalar localtime }} } @@ -260,7 +260,7 @@ during the run_step hook. ->validate (hook - uses CGI::Ex::Validate to validate form info) ->hash_validation (hook) ->file_val (hook) - ->base_dir_abs + ->vob_path (defaults to template_path) ->base_dir_rel ->name_module ->name_step @@ -591,13 +591,14 @@ are also documented more in the HOOKS AND METHODS section. =over 4 -=item base_dir_abs +=item template_path -Absolute path or arrayref of paths to the base templates directory. Default "". +Absolute path or arrayref of paths to the base templates directory. Defaults to +base_dir_abs which defaults to ['.']. =item base_dir_rel -Relative path inside of the base_dir_abs directory where content can be found. Default "". +Relative path inside of the template_path directory where content can be found. Default "". =item name_module @@ -632,7 +633,7 @@ a contrived example. The following is a hypothetical layout for your templates: In this example we would most likely set values as follows: - base_dir_abs /home/user/templates + template_path /home/user/templates base_dir_rel content name_module my_app @@ -648,7 +649,7 @@ 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 + template_path /home/user/templates base_dir_rel content name_module my_app name_step step1 @@ -662,13 +663,13 @@ The call to the template engine would look something like the following: my $t = $self->template_obj({ - INCLUDE_PATH => $self->base_dir_abs, + INCLUDE_PATH => $self->template_path, # defaults to 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). +inside of the absolute paths (from template_path). The call to the validation engine would pass the absolute filename that is returned by file_val. @@ -677,7 +678,7 @@ 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 + template_path /home/user/templates base_dir_rel name_module content/my_app @@ -1052,12 +1053,12 @@ See the get_valid_auth method. =item base_dir_abs (method) -Used as the absolute base directory to find template files and validation files. +Used as the absolute base directory to find template, validation and conf 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 "". +Default value is ['.']. For example, to pass multiple paths, you would use something similar to the following: @@ -1066,27 +1067,29 @@ similar to the following: 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. +The base_dir_abs value is used by template_path 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. +The base_dir_abs method is also used as the default value for conf_path and vob_path. + =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 +The template_path method is used as top level where template includes may +pull from, while the base_dir_rel is directory relative to the template_path 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 template_path and base_dir_abs methods for more discussion. See the section on FINDING TEMPLATES for further discussion. @@ -1122,6 +1125,67 @@ The following items will be cleared: hash_swap hash_common +=item conf (method) + +Used by default in init_from_conf if load_conf returns true. +Will try to read the file returned by the conf_file method +using the object returned by conf_obj using that object's read +method. If conf_validation returns a non-empty hashref, the +conf hash will be validated using $self->vob->validate (see the +validate method). + +This method may be used for other purposes as well (including when +load_conf is false).. + +Caches results in $self->{'conf'}. + +=item conf_file (method) + +Used by conf for finding the configuration file to load. Defaults +to $self->{'conf_file'} which defaults $self->name_module with the extention +returned by $self->conf_ext added on. For example, if name_module +returns "my_app" and conf_ext returns "ini" the value returned will +be "my_app.ini". + +The value returned can absolute. If the value will be searched for +in the paths passed to conf_obj. + +The conf_ext may be any of those extentions understood by CGI::Ex::Conf. + +=item conf_ext + +Used by the default conf_file method. Defaults to $self->{'conf_ext'} which +defaults to 'pl' meaning that the read configuration file should return a +valid perl hashref. + +=item conf_obj + +Used by the conf method to load the file returned by conf_file. Defaults +to conf_obj which defaults to loading args from conf_args, adding in paths +returned by conf_path, and calling CGI::Ex::Conf->new. + +Any object that provides a read method that returns a hashref can be used. + +=item conf_path + +Defaults to $self->{'conf_path'} which defaults to base_dir_abs. Should be +a path or an arrayref of paths to look the configuration file returned by +conf_file when that file is not absolute. + +=item conf_args + +Used by conf_obj. + +Defaults to $self->{'conf_args'} which defaults to {}. Will have +paths => $self->conf_path added before passing to CGI::Ex::Conf->new. + +=item conf_validation + +Used by default conf method. +Defaults to an empty hashref. If non-empty hashref is passed, the +hashref returned by conf_obj->read will be validated using the hashref +returned by conf_validation. + =item current_step (method) Returns the current step that the nav_loop is functioning on. @@ -1265,15 +1329,15 @@ Returns a filename of the content to be used in the default print hook. Adds method base_dir_rel to hook name_module, and name_step and adds on the default file extension found in $self->ext_print which defaults to the property $self->{ext_print} which will default to -".html". Should return a filename relative to base_dir_abs that can be +".html". Should return a filename relative to template_path that can be swapped using Template::Alloy, or should be a scalar reference to the template content that can be swapped. This will be used by the hook print. - sub base_dir_abs { '/var/www/templates' } - sub base_dir_rel { 'content' } - sub name_module { 'recipe' } - sub ext_print { 'html' } # default + sub template_path { '/var/www/templates' } + sub base_dir_rel { 'content' } + sub name_module { 'recipe' } + sub ext_print { 'html' } # default # ->file_print('this_step') # would return 'content/recipe/this_step.html' @@ -1286,12 +1350,13 @@ the data for the application in a single location. =item file_val (hook) -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). -If base_dir_abs returns an arrayref of paths, then each path is -checked for the existence of the file. +Returns a filename containing the validation. Performs the same as +file_print, but uses ext_val to get the extension, and it adds +vob_path (which defaults to template_path which defaults to +base_dir_abs) onto the returned value (file_print is relative to +template_path, while file_val is fully qualified with vob_path). If +vob_path 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. @@ -1540,6 +1605,16 @@ Called by the default new method. Allows for any object initilizations that may need to take place. Default action does nothing. +=item init_from_conf (method) + +Called by the default new method. If load_conf is true, then the +conf method will be called and the keys returned will be added to +the $self object. + +This method is called after the init method. If you need to further +fix up values added during init_from_conf, you can use the pre_navigate +method. + =item insert_path (method) Arguments are the steps to insert. Can be called any time. Inserts @@ -1635,6 +1710,14 @@ jumping (the path is modified so that the path history is not destroyed Returns the last step of the path. Can be used to jump to the last step. +=item load_conf (method) + +Defaults to ->{load_conf} which defaults to false. If true, will +allow keys returned by the conf method to be added to $self during +the init_from_conf method. + +Enabling this method allows for out-of-the-box file based configuration. + =item morph (method) Allows for temporarily "becoming" another object type for the @@ -1977,16 +2060,27 @@ List the step previous to this one. Will return '' if there is no previous step =item print (hook) -Take the information generated by prepared_print, format it, and print -it out. Default incarnation uses CGI::Ex::Template (a subclass of -Template::Alloy) which is compatible with Template::Toolkit. -Arguments are: step name (used to call the file_print hook), swap -hashref (passed to call swap_template), and fill hashref (passed to -fill_template). +Take the information generated by prepared_print, format it using +swap_template, fill it using fill_template and print it out using +print_out. Default incarnation uses CGI::Ex::Template (a subclass of +Template::Alloy) which is compatible with Template::Toolkit to do the +swapping. Arguments are: step name (used to call the file_print +hook), swap hashref (passed to call swap_template), and fill hashref +(passed to fill_template). During the print call, the file_print hook is called which should return a filename or a scalar reference to the template content is +=item print_out (hook) + +Called with the finished document. Should print out the appropriate headers. +The default method calls $self->cgix->print_content_type and then +prints the content. + +The print_content_type is passed $self->mimetype (which defaults to +$self->{'mimetype'} which defaults to 'text/html') and $self->charset +(which defaults to $self->{'charset'} which defaults to ''). + =item ready_validate (hook) Should return true if enough information is present to run validate. @@ -2229,7 +2323,7 @@ CGI::Ex::Template a subclass of Template::Alloy). 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 (which will be used to initialize INCLUDE_PATH by +template_path (which will be used to initialize INCLUDE_PATH by default). The default method will create a template object by calling the @@ -2255,7 +2349,7 @@ method as follows: my $t = HTML::Template->new(source => $file, type => $type, - path => $self->base_dir_abs, + path => $self->template_path, die_on_bad_params => 0, ); @@ -2277,7 +2371,7 @@ For a listing of the available syntaxes, see the current L docu Returns a hashref of args that will be passed to the "new" method of CGI::Ex::Template. 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 +will add a value for INCLUDE_PATH which is set equal to template_path, if the INCLUDE_PATH value is not already set. The returned hashref can contain any arguments that CGI::Ex::Template (a subclass of Template::Alloy) @@ -2295,7 +2389,7 @@ See the L documentation for a listing of all possible configura =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 +that have had a default INCLUDE_PATH added via template_path. The default implementation uses CGI::Ex::Template (a subclass of Template::Alloy) but can easily be changed to use Template::Toolkit by using code similar to the following: @@ -2307,6 +2401,11 @@ similar to the following: return Template->new($args); } +=item template_path (method) + +Defaults to $self->{'template_path'} which defaults to base_dir_abs. Used by +the template_obj method. + =item unmorph (method) Allows for returning an object back to its previous blessed state if @@ -2513,7 +2612,7 @@ CGI::Ex::App is differrent in that it: The following example shows the creation of a basic recipe database. It requires the use of DBD::SQLite, but that is all. -Once you have configured the db_file and base_dir_abs methods +Once you have configured the db_file and template_path methods of the "recipe" file, you will have a working script that does CRUD for the recipe table. The observant reader may ask - why not use Catalyst or Ruby on Rails? The observant programmer will @@ -2553,7 +2652,7 @@ the core logic of the application. debug shift->dump_history; } - sub base_dir_abs { '/var/www/templates' } + sub template_path { '/var/www/templates' } sub base_dir_rel { 'content' } diff --git a/lib/CGI/Ex/Auth.pm b/lib/CGI/Ex/Auth.pm index ea3e346..7362ed1 100644 --- 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; -$VERSION = '2.16'; +$VERSION = '2.17'; ###----------------------------------------------------------------### diff --git a/lib/CGI/Ex/Conf.pm b/lib/CGI/Ex/Conf.pm index 3af42e5..d7db3ba 100644 --- 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); -$VERSION = '2.16'; +$VERSION = '2.17'; $DEFAULT_EXT = 'conf'; @@ -134,7 +134,7 @@ sub conf_read { ### don't die if the file is not found - do die otherwise if (! -e $file) { - eval { die "Conf file $file not found" }; + eval { die "Conf file $file not found\n" }; warn "Conf file $file not found" if ! $args->{'no_warn_on_fail'} && ! $NO_WARN_ON_FAIL; return; } diff --git a/lib/CGI/Ex/Die.pm b/lib/CGI/Ex/Die.pm index 98fcc47..d592257 100644 --- 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 { - $VERSION = '2.16'; + $VERSION = '2.17'; $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 ac1b31c..54cecdc 100644 --- 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; -$VERSION = '2.16'; +$VERSION = '2.17'; @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 308c537..beeb542 100644 --- 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 { - $VERSION = '2.16'; + $VERSION = '2.17'; @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 f28e444..4e734d7 100644 --- a/lib/CGI/Ex/JSONDump.pm +++ b/lib/CGI/Ex/JSONDump.pm @@ -17,7 +17,7 @@ use strict; use base qw(Exporter); BEGIN { - $VERSION = '2.16'; + $VERSION = '2.17'; @EXPORT = qw(JSONDump); @EXPORT_OK = @EXPORT; diff --git a/lib/CGI/Ex/Template.pm b/lib/CGI/Ex/Template.pm index d9a4f54..0d3d7b4 100644 --- a/lib/CGI/Ex/Template.pm +++ b/lib/CGI/Ex/Template.pm @@ -25,7 +25,7 @@ use vars qw($VERSION $VOBJS ); -$VERSION = '2.16'; +$VERSION = '2.17'; ### install true symbol table aliases that can be localized *QR_PRIVATE = *Template::Alloy::QR_PRIVATE; diff --git a/lib/CGI/Ex/Validate.pm b/lib/CGI/Ex/Validate.pm index 3d47299..d8b3e7e 100644 --- a/lib/CGI/Ex/Validate.pm +++ b/lib/CGI/Ex/Validate.pm @@ -22,7 +22,7 @@ use vars qw($VERSION @UNSUPPORTED_BROWSERS ); -$VERSION = '2.16'; +$VERSION = '2.17'; $DEFAULT_EXT = 'val'; $QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/; diff --git a/t/0_ex_00_base.t b/t/0_ex_00_base.t index 387170a..5966a15 100644 --- a/t/0_ex_00_base.t +++ b/t/0_ex_00_base.t @@ -6,8 +6,15 @@ =cut +use vars qw($test_stdout @ISA); use strict; -use Test::More tests => 63; +use Test::More tests => 73; + +sub TIEHANDLE { bless [], __PACKAGE__ } +sub PRINT { + my $self = shift; + $test_stdout = join("", @_); +} use_ok('CGI::Ex'); @@ -46,6 +53,49 @@ ok($form->{'foo'} eq 'bar', "Could set form"); my $cookies = $cgix->cookies; ok($cookies->{'foo'} eq 'bar', "Could set form"); +### try print_content_type +if (eval { require Tie::Handle }) { + local @ISA = qw(Tie::Handle); + my $old_out = select STDOUT; + + foreach ([[] => "Content-Type: text/html\r\n\r\n"], + [['text/html'] => "Content-Type: text/html\r\n\r\n"], + [['text/html', ''] => "Content-Type: text/html\r\n\r\n"], + [['image/gif'] => "Content-Type: image/gif\r\n\r\n"], + [['text/html', 'utf-8'], => "Content-Type: text/html; charset=utf-8\r\n\r\n"], + [[$cgix, ] => "Content-Type: text/html\r\n\r\n"], + [[$cgix, 'text/html'] => "Content-Type: text/html\r\n\r\n"], + [[$cgix, 'text/html', ''] => "Content-Type: text/html\r\n\r\n"], + [[$cgix, 'image/gif'] => "Content-Type: image/gif\r\n\r\n"], + [[$cgix, 'text/html', 'utf-8'], => "Content-Type: text/html; charset=utf-8\r\n\r\n"], + ) { + local $ENV{'MOD_PERL'} = 0; + local $ENV{'CONTENT_TYPED'} = 0; + my ($args, $answer) = @$_; + + LOCAL: { + local *STDOUT; + tie *STDOUT, __PACKAGE__; + CGI::Ex::print_content_type(@$args); + }; + + select $old_out; + + (my $ans = $answer) =~ s/\s+$//; + if ($test_stdout eq $answer) { + ok(1, "(@$args) => $ans"); + } else { + ok(0, "(@$args) => $ans"); + print "#($test_stdout)\n"; + } + } + + select $old_out; +} else { + SKIP: { + skip("Can't test print_content_type", 10); + }; +} ### try out make_form my $str = $cgix->make_form($form); diff --git a/t/4_app_00_base.t b/t/4_app_00_base.t index ec223d8..78148d5 100644 --- a/t/4_app_00_base.t +++ b/t/4_app_00_base.t @@ -13,7 +13,7 @@ we do try to put it through most paces. =cut -use Test::More tests => 20; +use Test::More tests => 25; use strict; { @@ -153,7 +153,7 @@ ok($Foo::test_stdout eq "Login Form", "Got the right output"); { package Bar; - @Bar::ISA = qw(Foo); + our @ISA = qw(Foo); sub require_auth { 1 } } @@ -166,7 +166,7 @@ ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar"); { package Bar1; - @Bar1::ISA = qw(Foo); + our @ISA = qw(Foo); sub require_auth { 1 } } @@ -179,7 +179,7 @@ ok(! $ok, "Got the right output for Bar1"); { package Bar2; - @Bar2::ISA = qw(Foo); + our @ISA = qw(Foo); sub main_require_auth { 1 } } @@ -192,7 +192,7 @@ ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar2"); { package Bar3; - @Bar3::ISA = qw(Foo); + our @ISA = qw(Foo); sub require_auth { 1 } sub main_require_auth { 0 } } @@ -222,7 +222,7 @@ ok($Foo::test_stdout eq "Login Form", "Got the right output"); { package Bar4; - @Bar4::ISA = qw(Foo); + our @ISA = qw(Foo); sub pre_navigate { shift->require_auth(0); 0 } } @@ -235,7 +235,7 @@ ok($Foo::test_stdout eq "Main Content", "Got the right output for Bar4"); { package Bar5; - @Bar5::ISA = qw(Foo); + our @ISA = qw(Foo); sub pre_navigate { shift->require_auth(1); 0 } } @@ -248,7 +248,7 @@ ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar5 ($@)"); { package Bar6; - @Bar6::ISA = qw(Foo); + our @ISA = qw(Foo); sub pre_navigate { shift->require_auth({main => 1}); 0 } } @@ -256,3 +256,35 @@ Bar6->new({ form => {}, })->navigate; ok($Foo::test_stdout eq "Login Form", "Got the right output for Bar6 ($@)"); + +###----------------------------------------------------------------### + +{ + package Conf1; + our @ISA = qw(Foo); + sub name_module { 'conf_1' } +} + +my $file = Conf1->new->conf_file; +ok($file && $file eq 'conf_1.pl', "Got a conf_file ($file)"); + +$file = Conf1->new({conf_ext => 'ini'})->conf_file; +ok($file && $file eq 'conf_1.ini', "Got a conf_file ($file)"); + +eval { Conf1->new({ + load_conf => 1, +})->navigate }; +my $err = $@; +ok($err, "Got an error"); +chomp $err; +ok($Foo::test_stdout eq "", "Got the right output for Conf1 ($err)"); + +Conf1->new({ + load_conf => 1, + conf => { + form => {step => 'step3'}, + }, +})->navigate; +ok($Foo::test_stdout eq "All good", "Got the right output for Conf1"); + +###----------------------------------------------------------------### -- 2.43.0