File Coverage

blib/lib/HTML/FormTemplate.pm
Criterion Covered Total %
statement 43 640 6.7
branch 0 266 0.0
condition 1 64 1.5
subroutine 9 70 12.8
pod 53 53 100.0
total 106 1093 9.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             HTML::FormTemplate - Make data-defined persistant forms, reports
4              
5             =cut
6              
7             ######################################################################
8              
9             package HTML::FormTemplate;
10             require 5.004;
11              
12             # Copyright (c) 1999-2004, Darren R. Duncan. All rights reserved. This module
13             # is free software; you can redistribute it and/or modify it under the same terms
14             # as Perl itself. However, I do request that this copyright information and
15             # credits remain attached to the file. If you modify this module and
16             # redistribute a changed version then please attach a note listing the
17             # modifications. This module is available "as-is" and the author can not be held
18             # accountable for any problems resulting from its use.
19              
20 1     1   1722 use strict;
  1         2  
  1         39  
21 1     1   4 use warnings;
  1         2  
  1         33  
22 1     1   4 use vars qw($VERSION @ISA);
  1         5  
  1         76  
23             $VERSION = '2.03';
24              
25             ######################################################################
26              
27             =head1 DEPENDENCIES
28              
29             =head2 Perl Version
30              
31             5.004
32              
33             =head2 Standard Modules
34              
35             I
36              
37             =head2 Nonstandard Modules
38              
39             Class::ParamParser 1.041
40             HTML::EasyTags 1.071
41             Data::MultiValuedHash 1.081
42             CGI::MultiValuedHash 1.09
43              
44             =cut
45              
46             ######################################################################
47              
48 1     1   854 use Class::ParamParser 1.041;
  1         1007  
  1         36  
49             @ISA = qw( Class::ParamParser );
50 1     1   983 use HTML::EasyTags 1.071;
  1         2495  
  1         39  
51 1     1   1180 use Data::MultiValuedHash 1.081;
  1         3378  
  1         30  
52 1     1   966 use CGI::MultiValuedHash 1.09;
  1         2711  
  1         24022  
53              
54             ######################################################################
55              
56             =head1 SYNOPSIS
57              
58             #!/usr/bin/perl
59             use strict;
60             use warnings;
61              
62             use HTML::FormTemplate;
63             use HTML::EasyTags;
64              
65             my @definitions = (
66             {
67             visible_title => "What's your name?",
68             type => 'textfield',
69             name => 'name',
70             is_required => 1,
71             }, {
72             visible_title => "What's the combination?",
73             type => 'checkbox_group',
74             name => 'words',
75             'values' => ['eenie', 'meenie', 'minie', 'moe'],
76             default => ['eenie', 'minie'],
77             }, {
78             visible_title => "What's your favorite colour?",
79             type => 'popup_menu',
80             name => 'color',
81             'values' => ['red', 'green', 'blue', 'chartreuse'],
82             }, {
83             type => 'submit',
84             },
85             );
86              
87             my $query_string = '';
88             read( STDIN, $query_string, $ENV{'CONTENT_LENGTH'} );
89             chomp( $query_string );
90              
91             my $form = HTML::FormTemplate->new();
92             $form->form_submit_url(
93             'http://'.($ENV{'HTTP_HOST'} || '127.0.0.1').$ENV{'SCRIPT_NAME'} );
94             $form->field_definitions( \@definitions );
95             $form->user_input( $query_string );
96              
97             my ($mail_worked, $mail_failed);
98             unless( $form->new_form() ) {
99             if( open( MAIL, "|/usr/lib/sendmail -t") ) {
100             print MAIL "To: perl\@DarrenDuncan.net\n";
101             print MAIL "From: perl\@DarrenDuncan.net\n";
102             print MAIL "Subject: A Simple Example HTML::FormTemplate Submission\n";
103             print MAIL "\n";
104             print MAIL $form->make_text_input_echo()."\n";
105             close ( MAIL );
106             $mail_worked = 1;
107             } else {
108             $mail_failed = 1;
109             }
110             }
111              
112             my $tagmaker = HTML::EasyTags->new();
113              
114             print
115             "Status: 200 OK\n",
116             "Content-type: text/html\n\n",
117             $tagmaker->start_html( 'A Simple Example' ),
118             $tagmaker->h1( 'A Simple Example' ),
119             $form->make_html_input_form( 1 ),
120             $tagmaker->hr,
121             $form->new_form() ? '' : $form->make_html_input_echo( 1 ),
122             $mail_worked ? "

Your favorites were emailed.

\n" : '',
123             $mail_failed ? "

Error emailing your favorites.

\n" : '',
124             $tagmaker->end_html;
125              
126             =head1 DESCRIPTION
127              
128             This Perl 5 object class can create web fill-out forms as well as parse,
129             error-check, and report their contents. Forms can start out blank or with
130             initial values, or by repeating the user's last input values. Facilities for
131             interactive user-input-correction are also provided.
132              
133             The class is designed so that a form can be completely defined, using
134             field_definitions(), before any html is generated or any error-checking is done.
135             For that reason, a form can be generated multiple times, each with a single
136             function call, while the form only has to be defined once. Form descriptions can
137             optionally be read from a file by the calling code, making that code a lot more
138             generic and robust than code which had to define the field manually.
139              
140             =head1 OVERVIEW
141              
142             If the calling code provides a MultiValuedHash object or HASH ref containing the
143             parsed user input from the last time the form was submitted, via user_input(),
144             then the newly generated form will incorporate that, making the entered values
145             persistant. Since the calling code has control over the provided "user input",
146             they can either get it live or read it from a file, which is transparent to us.
147             This makes it easy to make programs that allow the user to "come back later" and
148             continue editing where they left off, or to seed a form with initial values.
149             (Field definitions can also contain initial values.)
150              
151             Based on the provided field definitions, this module can do some limited user
152             input checking, and automatically generate error messages and help text beside
153             the appropriate form fields when html is generated, so to show the user exactly
154             what they have to fix. The "error state" for each field is stored in a hash,
155             which the calling code can obtain and edit using invalid_input(), so that results
156             of its own input checking routines are reflected in the new form.
157              
158             This class also provides utility methods that you can use to create form field
159             definitions that, when fed back to this class, generates field html that can be
160             used by CGI scripts to allow users with their web browsers to define other form
161             definitions for use with this class.
162              
163             Note that this class is a subclass of Class::ParamParser, and inherits
164             all of its methods, "params_to_hash()" and "params_to_array()".
165              
166             =head1 RECOGNIZED FORM FIELD TYPES
167              
168             This class recognizes 10 form field types, and a complete field of that type can
169             be made either by providing a "field definition" with the same "type" attribute
170             value, or by calling a method with the same name as the field type. Likewise,
171             groups of related form fields can be made with either a single field definition
172             or method call, for all of those field types.
173              
174             Standalone fields of the following types are recognized:
175              
176             =over 4
177              
178             =item 0
179              
180             B - makes a reset button
181              
182             =item 0
183              
184             B - makes a submit button
185              
186             =item 0
187              
188             B - makes a hidden field, which the user won't see
189              
190             =item 0
191              
192             B - makes a text entry field, one row high
193              
194             =item 0
195              
196             B - same as textfield except contents are bulleted out
197              
198             =item 0
199              
200             B" form tags.
2309              
2310             sub _make_textarea_html {
2311 0     0     my ($self, $defin) = @_;
2312              
2313             # Set up default attributes common to textarea tags.
2314              
2315 0           my %params = (
2316 0           %{$defin->fetch_value( $FKEY_TAG_ATTR )},
2317             name => $defin->fetch_value( $FKEY_NAME ),
2318             );
2319 0           my $default = $defin->fetch_value( $FKEY_DEFAULTS );
2320              
2321             # Make the field HTML and return it.
2322              
2323 0           my $tagmaker = $self->{$KEY_TAG_MAKER};
2324 0           return( $tagmaker->make_html_tag( 'textarea', \%params, $default ) );
2325             }
2326              
2327             ######################################################################
2328             # _make_textarea_group_html( DEFIN )
2329             # This private method assists _make_field_html() by specializing in making
2330             # a group of "" form tags.
2331              
2332             sub _make_textarea_group_html {
2333 0     0     my ($self, $defin) = @_;
2334              
2335             # Set up default attributes common to textarea tags.
2336              
2337 0           my %params = (
2338 0           %{$defin->fetch_value( $FKEY_TAG_ATTR )},
2339             name => $defin->fetch_value( $FKEY_NAME ),
2340             );
2341 0           my @defaults = $defin->fetch( $FKEY_DEFAULTS );
2342              
2343             # Make sure we have enough group members.
2344              
2345 0           my $wanted = $defin->fetch_value( $FKEY_MIN_GRP_COUNT );
2346 0           my $have = @defaults;
2347 0 0         if( $have < $wanted ) {
2348 0           push( @defaults, [map { '' } (1..($wanted - $have))] );
  0            
2349             }
2350              
2351             # Make the field HTML and return it.
2352              
2353 0           my $tagmaker = $self->{$KEY_TAG_MAKER};
2354 0           return( $tagmaker->make_html_tag_group(
2355             'textarea', \%params, \@defaults, 1 ) );
2356             }
2357              
2358             ######################################################################
2359             # _make_input_html( DEFIN )
2360             # This private method assists _make_field_html() by specializing in making
2361             # single "" form tags.
2362              
2363             sub _make_input_html {
2364 0     0     my ($self, $defin) = @_;
2365 0           my $type = $defin->fetch_value( $FKEY_TYPE );
2366              
2367             # Set up default attributes common to all input tags.
2368              
2369 0           my %params = (
2370 0           %{$defin->fetch_value( $FKEY_TAG_ATTR )},
2371             type => $INPUT_TAG_IMPL_TYPE{$type},
2372             name => $defin->fetch_value( $FKEY_NAME ),
2373             value => $defin->fetch_value( $FKEY_DEFAULTS ),
2374             );
2375 0           my $label = '';
2376              
2377             # Set up attributes that are unique to check boxes and radio buttons.
2378             # One difference is that user input affects the "checked" attribute
2379             # instead of "value".
2380              
2381 0 0 0       if( $type eq 'checkbox' or $type eq 'radio' ) {
2382 0           $params{value} = $defin->fetch_value( $FKEY_VALUES );
2383 0 0         defined( $params{value} ) or $params{value} = 'on';
2384 0           $params{checked} = $defin->fetch_value( $FKEY_DEFAULTS );
2385 0           $label = $defin->fetch_value( $FKEY_LABELS );
2386 0 0         defined( $label ) or $label = $params{name};
2387 0 0         $defin->fetch_value( $FKEY_NOLABELS ) and $label = '';
2388              
2389             # For most input tag types, an empty "value" attribute is useless so
2390             # get rid of it. For buttons an empty value leads to no button label.
2391              
2392             } else {
2393 0 0         $params{value} eq '' and delete( $params{value} );
2394             }
2395              
2396             # Make the field HTML and return it.
2397              
2398 0           my $tagmaker = $self->{$KEY_TAG_MAKER};
2399 0           return( $tagmaker->make_html_tag( 'input', \%params, $label ) );
2400             }
2401              
2402             ######################################################################
2403             # _make_input_group_html( DEFIN )
2404             # This private method assists _make_field_html() by specializing in making
2405             # a group of "" form tags.
2406              
2407             sub _make_input_group_html {
2408 0     0     my ($self, $defin) = @_;
2409 0           my $type = $defin->fetch_value( $FKEY_TYPE );
2410              
2411             # Set up default attributes common to all input tags.
2412              
2413 0           my %params = (
2414 0   0       %{$defin->fetch_value( $FKEY_TAG_ATTR )},
2415             type => $INPUT_TAG_IMPL_TYPE{$type},
2416             name => $defin->fetch_value( $FKEY_NAME ),
2417             value => scalar( $defin->fetch( $FKEY_DEFAULTS ) ) || [],
2418             );
2419 0           my @labels = ();
2420              
2421             # Set up attributes that are unique to checkboxes and radio buttons.
2422             # One difference is that user input affects the "checked" attribute
2423             # instead of "value".
2424              
2425 0 0 0       if( $type eq 'checkbox_group' or $type eq 'radio_group' ) {
2426 0   0       my $ra_values = $defin->fetch( $FKEY_VALUES ) || ['on'];
2427 0           $params{value} = $ra_values;
2428              
2429             # The definition property "defaults" may be either an array ref
2430             # or a hash ref. If it is a hash ref then the hash keys would
2431             # correspond to field values and the hash values would be either
2432             # true or false to indicate if it is selected. If it is an array
2433             # ref then the array elements would be a list of field values,
2434             # all of which are selected. This code block takes either
2435             # variable type and coerces the data into an array ref that has
2436             # the same number of elements as there are field values, and each
2437             # corresponding element is either true or false; this format is
2438             # what HTML::EasyTags needs as input.
2439              
2440 0   0       my $ra_defaults = $defin->fetch( $FKEY_DEFAULTS ) || []; # array
2441 0 0         if( ref( $ra_defaults->[0] ) eq 'HASH' ) {
2442 0           $ra_defaults = $ra_defaults->[0]; # hash
2443             }
2444 0 0         if( ref( $ra_defaults ) eq 'ARRAY' ) {
2445 0           $ra_defaults = {map { ( $_ => 1 ) } @{$ra_defaults}}; # hash
  0            
  0            
2446             }
2447 0           $ra_defaults = [map { $ra_defaults->{$_} } @{$ra_values}]; # ary
  0            
  0            
2448 0           $params{checked} = $ra_defaults;
2449              
2450             # The definition property "labels" may be either an array ref
2451             # or a hash ref. If it is a hash ref then the hash keys would
2452             # correspond to field values and the hash values would be the
2453             # labels associated with them; this is coerced into an array.
2454             # If it is an array ref then the elements already are
2455             # counterparts to the field value list. If any labels are
2456             # undefined then the appropriate field value is used as a label.
2457              
2458 0   0       my $ra_labels = $defin->fetch( $FKEY_LABELS ) || []; # array
2459 0 0         if( ref( $ra_labels->[0] ) eq 'HASH' ) {
2460 0           $ra_labels = $ra_labels->[0]; # hash
2461 0           $ra_labels = [map { $ra_labels->{$_} } @{$ra_values}]; # ary
  0            
  0            
2462             }
2463 0           foreach my $index (0..$#{$ra_values}) {
  0            
2464 0 0         unless( defined( $ra_labels->[$index] ) ) {
2465 0           $ra_labels->[$index] = $ra_values->[$index];
2466             }
2467             }
2468 0 0         $defin->fetch_value( $FKEY_NOLABELS ) and $ra_labels = [];
2469 0           @labels = @{$ra_labels};
  0            
2470              
2471             # Make sure we have enough group members.
2472              
2473             } else {
2474 0           my $wanted = $defin->fetch_value( $FKEY_MIN_GRP_COUNT );
2475 0           my $have = @{$params{value}};
  0            
2476 0 0         if( $have < $wanted ) {
2477 0           push( @{$params{value}}, [map { '' } (1..($wanted - $have))] );
  0            
  0            
2478             }
2479             }
2480              
2481             # Make the field HTML and return it.
2482              
2483 0           my $tagmaker = $self->{$KEY_TAG_MAKER};
2484 0           return( $tagmaker->make_html_tag_group( 'input', \%params, \@labels, 1 ) );
2485             }
2486              
2487             ######################################################################
2488             # _make_select_html( DEFIN )
2489             # This private method assists _make_field_html() by specializing in making
2490             # single "" form tags, which include a group of
2491              
2492             sub _make_select_html {
2493 0     0     my ($self, $defin) = @_;
2494              
2495             # Set up default attributes for the option tags.
2496              
2497 0   0       my $ra_values = $defin->fetch( $FKEY_VALUES ) || ['on'];
2498              
2499             # The definition property "defaults" is handled the same way as the
2500             # same property for checkbox groups, so refer to the documentation there.
2501              
2502 0   0       my $ra_defaults = $defin->fetch( $FKEY_DEFAULTS ) || []; # array
2503 0 0         if( ref( $ra_defaults->[0] ) eq 'HASH' ) {
2504 0           $ra_defaults = $ra_defaults->[0]; # hash
2505             }
2506 0 0         if( ref( $ra_defaults ) eq 'ARRAY' ) {
2507 0           $ra_defaults = {map { ( $_ => 1 ) } @{$ra_defaults}}; # hash
  0            
  0            
2508             }
2509 0           $ra_defaults = [map { $ra_defaults->{$_} } @{$ra_values}]; # ary
  0            
  0            
2510              
2511             # The definition property "labels" is handled the same way as the
2512             # same property for checkbox groups, so refer to the documentation there.
2513              
2514 0   0       my $ra_labels = $defin->fetch( $FKEY_LABELS ) || []; # array
2515 0 0         if( ref( $ra_labels->[0] ) eq 'HASH' ) {
2516 0           $ra_labels = $ra_labels->[0]; # hash
2517 0           $ra_labels = [map { $ra_labels->{$_} } @{$ra_values}]; # ary
  0            
  0            
2518             }
2519 0           foreach my $index (0..$#{$ra_values}) {
  0            
2520 0 0         unless( defined( $ra_labels->[$index] ) ) {
2521 0           $ra_labels->[$index] = $ra_values->[$index];
2522             }
2523             }
2524              
2525             # Set up default attributes common to all select tags.
2526              
2527 0           my %params = (
2528 0           %{$defin->fetch_value( $FKEY_TAG_ATTR )},
2529             name => $defin->fetch_value( $FKEY_NAME ),
2530             );
2531 0   0       $params{size} ||= scalar( @{$ra_values} );
  0            
2532              
2533             # Set up attributes that are unique to popup menus. They are
2534             # different in that only one item can be displayed at a time, and
2535             # correspondingly the user can only choose one item at a time.
2536              
2537 0 0         if( $defin->fetch_value( $FKEY_TYPE ) eq 'popup_menu' ) {
2538 0           $params{size} = 1;
2539 0           $params{multiple} = 0;
2540             }
2541              
2542             # Make the field HTML and return it.
2543              
2544 0           my $tagmaker = $self->{$KEY_TAG_MAKER};
2545 0           return( join( '',
2546             $tagmaker->make_html_tag( 'select', \%params, undef, 'start' ),
2547 0           @{$tagmaker->make_html_tag_group( 'option', { value => $ra_values,
2548             selected => $ra_defaults }, $ra_labels, 1 )},
2549             $tagmaker->make_html_tag( 'select', {}, undef, 'end' ),
2550             ) );
2551             }
2552              
2553             ######################################################################
2554             # _make_select_group_html( DEFIN )
2555             # This private method assists _make_field_html() by specializing in making
2556             # a group of "" form tags.
2557              
2558             sub _make_select_group_html {
2559 0     0     my ($self, $defin) = @_;
2560              
2561             # Set up default attributes for the option tags.
2562              
2563 0   0       my $ra_values = $defin->fetch( $FKEY_VALUES ) || ['on'];
2564              
2565             # The definition property "labels" is handled the same way as the
2566             # same property for checkbox groups, so refer to the documentation there.
2567              
2568 0   0       my $ra_labels = $defin->fetch( $FKEY_LABELS ) || []; # array
2569 0 0         if( ref( $ra_labels->[0] ) eq 'HASH' ) {
2570 0           $ra_labels = $ra_labels->[0]; # hash
2571 0           $ra_labels = [map { $ra_labels->{$_} } @{$ra_values}]; # ary
  0            
  0            
2572             }
2573 0           foreach my $index (0..$#{$ra_values}) {
  0            
2574 0 0         unless( defined( $ra_labels->[$index] ) ) {
2575 0           $ra_labels->[$index] = $ra_values->[$index];
2576             }
2577             }
2578              
2579             # Set up default attributes common to all select tags.
2580              
2581 0           my %params = (
2582 0           %{$defin->fetch_value( $FKEY_TAG_ATTR )},
2583             name => $defin->fetch_value( $FKEY_NAME ),
2584             );
2585 0   0       $params{size} ||= scalar( @{$ra_values} );
  0            
2586              
2587             # Set up attributes that are unique to popup menus. They are
2588             # different in that only one item can be displayed at a time, and
2589             # correspondingly the user can only choose one item at a time.
2590              
2591 0 0         if( $defin->fetch_value( $FKEY_TYPE ) eq 'popup_menu_group' ) {
2592 0           $params{size} = 1;
2593 0           $params{multiple} = 0;
2594             }
2595              
2596             # Make sure we have a list of valid default values, and hash of said also.
2597             # The valid list is an intersection of current defaults and field values.
2598              
2599 0           my @defaults = $defin->fetch( $FKEY_DEFAULTS );
2600 0           my $rh_defaults = $defaults[0];
2601 0 0         unless( ref( $rh_defaults ) eq 'HASH' ) {
2602 0           $rh_defaults = {map { ( $_ => 1 ) } @defaults};
  0            
2603             }
2604 0           @defaults = grep { $rh_defaults->{$_} } @defaults;
  0            
2605              
2606             # Make sure we have enough group members.
2607              
2608 0           my $wanted = $defin->fetch_value( $FKEY_MIN_GRP_COUNT );
2609 0           my $have = @defaults;
2610 0 0         if( $have < $wanted ) {
2611 0           push( @defaults, [map { '' } (1..($wanted - $have))] );
  0            
2612             }
2613              
2614             # Make the field HTML and return it.
2615              
2616 0           my $tagmaker = $self->{$KEY_TAG_MAKER};
2617 0           my @field_list = ();
2618 0           foreach my $default (@defaults) {
2619 0           my $ra_defaults = [map { $_ eq $default } @{$ra_values}];
  0            
  0            
2620 0           push( @field_list, join( '',
2621             $tagmaker->make_html_tag( 'select', \%params, undef, 'start' ),
2622 0           @{$tagmaker->make_html_tag_group( 'option', { value => $ra_values,
2623             selected => $ra_defaults }, $ra_labels, 1 )},
2624             $tagmaker->make_html_tag( 'select', {}, undef, 'end' ),
2625             ) );
2626             }
2627 0           return( \@field_list );
2628             }
2629              
2630             ######################################################################
2631             # _join_field_group_html( DEFIN, LIST )
2632             # This private method assists _make_field_html() by joining together a list of
2633             # field group html, LIST, according to the field preferences in DEFIN. This
2634             # method will check a series of field definition properties in order until it
2635             # finds one that is true; it then joins the fields in accordance with that one.
2636             # These are the properties in order of precedence: 1. 'list' causes the LIST
2637             # elements to be returned as is (in an array ref), one field per element;
2638             # 2. 'linebreak' creates a scalar with group members delimited by
tags;
2639             # 3. 'table_cols' or 'table_rows' causes the group members to be formatted into
2640             # an HTML table, returned as a scalar; 4. otherwise, we join on ''.
2641              
2642             sub _join_field_group_html {
2643 0     0     my ($self, $defin, $ra_tag_html) = @_;
2644              
2645             # First, see if definition wants a list returned.
2646              
2647 0 0         $defin->fetch_value( $FKEY_LIST ) and return( $ra_tag_html );
2648              
2649             # Second, see if definition wants linebreak-delimited fields.
2650              
2651 0           $defin->fetch_value( $FKEY_LINEBREAK ) and
2652 0 0         return( join( '
', @{$ra_tag_html} ) );
2653              
2654             # Third, see if definition wants fields returned in an HTML table.
2655              
2656 0           my $cols = $defin->fetch_value( $FKEY_TABLE_COLS ); # 3 lines chg 2.01
2657 0           my $rows = $defin->fetch_value( $FKEY_TABLE_ROWS );
2658 0           my $acr_first = $defin->fetch_value( $FKEY_TABLE_ACRF );
2659 0 0 0       if( $cols or $rows ) {
2660 0           return( $self->make_table_from_list( $ra_tag_html,
2661             $cols, $rows, $acr_first ) );
2662             }
2663              
2664             # If none of the above, then return fields concatenated as is.
2665              
2666 0           return( join( '', @{$ra_tag_html} ) );
  0            
2667             }
2668              
2669             ######################################################################
2670              
2671             1;
2672             __END__