From: Kirrily R. <sk...@us...> - 2001-08-02 13:56:18
|
Update of /cvsroot/formmagick/formmagick/lib/CGI/FormMagick In directory usw-pr-cvs1:/tmp/cvs-serv11797 Modified Files: HTML.pm Log Message: Added some tests. It's hard to test this .pm, though, because a lot of the stuff is print_whatever and, well, either it prints or it doesn't, yknow? Index: HTML.pm =================================================================== RCS file: /cvsroot/formmagick/formmagick/lib/CGI/FormMagick/HTML.pm,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -r1.9 -r1.10 *** HTML.pm 2001/08/02 13:17:18 1.9 --- HTML.pm 2001/08/02 13:55:50 1.10 *************** *** 29,32 **** --- 29,34 ---- display_fields build_inputfield + gather_field_info + set_option_lv ); *************** *** 41,44 **** --- 43,61 ---- CGI::FormMagick::HTML - HTML output routines for FormMagick + =begin testing + use lib "../lib"; + use CGI::FormMagick; + + my $xml = qq( + <FORM TITLE="FormMagick demo application" POST-EVENT="submit_order"> + <PAGE NAME="Personal" TITLE="Personal details" POST-EVENT="lookup_group_info"> + <FIELD ID="firstname" LABEL="first name" TYPE="TEXT" VALIDATION="nonblank"/> + </PAGE> + </FORM> + ); + + my $fm = new CGI::FormMagick(TYPE => 'STRING', SOURCE => $xml); + + =end testing =head1 DESCRIPTION *************** *** 251,254 **** --- 268,323 ---- =pod + =head2 gather_field_info($fieldinfo) + + Gathers various information about a field and returns it as a hashref. + + =begin testing + my $cgi = CGI->new(""); # dummy empty CGI object + my $f = { # minimalist fieldinfo hashref + VALIDATION => 'foo', + LABEL => 'bar', + TYPE => 'TEXT', + ID => 'baz' + }; + + ok((my $i = $fm->gather_field_info($cgi, $f)), "Gather field info"); + ok(ref($i) eq 'HASH', "gather_field_info returning a hashref"); + ok(not ($fm->gather_field_info("abc")), "Fail on bogus args"); + + =end testing + + =cut + + sub gather_field_info { + my ($fm, $cgi, $fieldinfo) = @_; + unless (ref($cgi) =~ /CGI/) { + warn "CGI arg must be a CGI object (not '$cgi')" && return undef; + } + + my %f; + foreach (qw( VALIDATION LABEL TYPE ID OPTIONS DESCRIPTION CHECKED + MULTIPLE SIZE)) { + $f{lc($_)} = $fieldinfo->{$_} if $fieldinfo->{$_}; + } + + # value defaults to what the user filled in, if they filled + # something in on a previous visit to this field + if ($cgi->param($f{fieldname})) { + $f{value} = $cgi->param($f{fieldname}); + + # are we calling a subroutine to find the value? + } elsif ($fieldinfo->{VALUE} && $fieldinfo->{VALUE} =~ /()$/) { + $f{value} = $fm->call_defaultvalue_routine($cgi, $fieldinfo->{VALUE}); + + # otherwise, use VALUE attribute or default to blank. + } else { + $f{value} = $fieldinfo->{VALUE} || ""; + } + + return \%f; + } + + =pod + =head2 build_inputfield ($fm, $forminfo) *************** *** 256,259 **** --- 325,331 ---- containing information about the field. + =for testing + ok(my $if = $fm->build_inputfield($i, CGI::FormMagick::TagMaker->new()), "build input field"); + =cut *************** *** 332,368 **** =pod - =head2 gather_field_info($fieldinfo) - - Gathers various information about a field and returns it as a hashref. - - =cut - - sub gather_field_info { - my ($fm, $cgi, $fieldinfo) = @_; - my %f; - foreach (qw( VALIDATION LABEL TYPE ID OPTIONS DESCRIPTION CHECKED - MULTIPLE SIZE)) { - $f{lc($_)} = $fieldinfo->{$_}; - } - - # value defaults to what the user filled in, if they filled - # something in on a previous visit to this field - if ($cgi->param($f{fieldname})) { - $f{value} = $cgi->param($f{fieldname}); - - # are we calling a subroutine to find the value? - } elsif ($fieldinfo->{VALUE} && $fieldinfo->{VALUE} =~ /()$/) { - $f{value} = $fm->call_defaultvalue_routine($cgi, $fieldinfo->{VALUE}); - - # otherwise, use VALUE attribute or default to blank. - } else { - $f{value} = $fieldinfo->{VALUE} || ""; - } - - return \%f; - } - - =pod - =head2 set_option_lv($fm, $info) --- 404,407 ---- *************** *** 373,393 **** =cut ! sub set_option_info { my ($fm, $cgi, $info) = @_; - my @option_values; # values for an options list - my @option_labels; # displayed labels for an options list # if this is a grouped input (one with options), we'll need to # run the options function for it. - if (($info->{type} eq "SELECT") || ($info->{type} eq "RADIO")) { ! # DWIM whether the options are in a hash or an array. ! my $lv_hashref = $fm->get_option_labels_and_values($cgi, $info); - $info->{option_labels} = @{$lv_hashref->{labels}}; - $info->{option_values} = @{$lv_hashref->{vals}}; - } } - return 1; --- 412,428 ---- =cut ! sub set_option_lv { my ($fm, $cgi, $info) = @_; # if this is a grouped input (one with options), we'll need to # run the options function for it. ! # DWIM whether the options are in a hash or an array. ! my $lv_hashref = $fm->get_option_labels_and_values($cgi, $info); ! ! $info->{option_labels} = @{$lv_hashref->{labels}}; ! $info->{option_values} = @{$lv_hashref->{vals}}; } return 1; |