File Coverage

blib/lib/HTML/ReplaceForm.pm
Criterion Covered Total %
statement 38 40 95.0
branch 17 20 85.0
condition 1 3 33.3
subroutine 6 6 100.0
pod 1 1 100.0
total 63 70 90.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package HTML::ReplaceForm;
4 1     1   783 use base 'Exporter';
  1         2  
  1         87  
5 1     1   6 use Carp;
  1         3  
  1         88  
6             our @EXPORT_OK = qw(
7             replace_form
8             );
9 1     1   22 use strict;
  1         2  
  1         34  
10 1     1   5 use warnings;
  1         2  
  1         195  
11              
12             our $VERSION = '0.52';
13              
14             =head1 NAME
15              
16             HTML::ReplaceForm - easily replace HTML form fields with corresponding values
17              
18             =head1 SYNOPSIS
19              
20             use HTML::ReplaceForm;
21             $modified_html = replace_form($html,$data_href);
22              
23             =head1 DESCRIPTION
24              
25             This is useful for creating an HTML email message from a web form, while sharing
26             a single template that is used for both purposes.
27              
28             Keep the form in an include file that is used both on the web and in an email template.
29              
30             The real, regular HTML in the form will automatically have the form fields replaced with
31             corresponding values by the C function, which you can then use to send
32             the HTML email.
33              
34             =head1 FUNCTIONS
35              
36             =head2 replace_form
37              
38             $modified_html = replace_form($html,$data_href);
39              
40             Replace form elements with with a hashref of corresponding data.
41              
42              
43             B For now, replace radio and checkboxes with an X if they are marked.
44             They are troublesome because there are multiple inputs with the same name, and
45             they have labels next to them.
46              
47             Args:
48              
49             $html - Any kind of HTML data structure that HTML::TokeParser::Simple accepts
50             $data_href a hashref of data that corresponds to the form
51              
52             =cut
53              
54             sub replace_form {
55 9     9 1 425 my $html = shift;
56 9         9 my $data = shift;
57              
58 9         1627 require HTML::TokeParser::Simple;
59 9   33     44056 my $p = HTML::TokeParser::Simple->new( $html ) || croak $!;
60              
61 9         1188 my $new_html;
62 9         25 while ( my $token = $p->get_token ) {
63 13 100       933 if ($token->is_tag(qr/(input|textarea|select)/)) {
    100          
64 1     1   6 no warnings; # 'type' may be undefined. That's OK.
  1         1  
  1         445  
65 9 100       189 if ($token->return_attr('type') =~ m/^checkbox$/ ) {
    100          
    100          
66             # If we have a match from the data that matches this value
67 2 100       30 if ($token->return_attr('value') eq $data->{ $token->return_attr('name') } ) {
68             # XXX This should be customizable.
69 1         25 $new_html .= '[X]';
70             }
71             else {
72             # delete unchecked elements through neglect
73 1         20 $new_html .= '[ ] '
74             }
75             }
76             elsif ($token->return_attr('type') =~ m/^radio$/ ) {
77             # If we have a match from the data that matches this value
78 2 100       61 if ($token->return_attr('value') eq $data->{ $token->return_attr('name') } ) {
79             # XXX This should be customizable.
80 1         29 $new_html .= '(X)';
81             }
82             else {
83             # delete unchecked elements through neglect
84 1         23 $new_html .= '( ) '
85             }
86             }
87              
88             # XXX, there's a probably a bug where the contents of
89             # thrown away, too.
90              
91             # This clause would be needed if the form was refilled first.
92             # For textareas, just through away the tags and leave the contents.
93             elsif ( $token->is_tag('textarea') ) {
94 2 50       82 if (my $name = $token->return_attr('name')) {
95             # This should also be customizable for other templating systems.
96 2         31 $new_html .= qq{$data->{$name}};
97             # silently discard any previous contents of the textarea
98 2         8 $p->get_tag('/textarea');
99             }
100             else {
101 0         0 croak "no name found for: ".$token->as_is;
102             }
103             }
104             else {
105 3 50       136 if ($token->is_start_tag) {
106 3 50       20 if (my $name = $token->return_attr('name')) {
107 3         67 $new_html .= qq{$data->{$name}};
108             }
109             else {
110 0         0 croak "no name found for: ".$token->as_is;
111             }
112             }
113             else {
114             # just throw away the end tags.
115             }
116             }
117             }
118             # silently discard option tags
119             elsif ( $token->is_start_tag('option') ) {
120 2         55 $p->get_tag('/select');
121             }
122             else {
123 2         21 $new_html .= $token->as_is;
124             }
125             }
126 9         501 return $new_html;
127             }
128              
129             =head2 TODO
130              
131             There are small bits of HTML design which are currently embedded in here. The user should
132             have control over these.
133              
134             - $data is displayed as $data
135             - A selected checkbox or radio button is displayed as [X]
136             - An unselected checkbox or radio button is displayed as [ ]
137              
138             =head1 AUTHOR
139              
140             Mark Stosberg C<< mark at summersault.com >>
141              
142             =head1 COPYRIGHT
143              
144             This program is free software; you can redistribute
145             it and/or modify it under the same terms as Perl itself.
146              
147             The full text of the license can be found in the
148             LICENSE file included with this module.
149              
150             =head1 SEE ALSO
151              
152             perl(1).
153              
154             =cut
155              
156             1;