File Coverage

blib/lib/WWW/Form.pm
Criterion Covered Total %
statement 231 366 63.1
branch 37 82 45.1
condition 15 28 53.5
subroutine 36 48 75.0
pod 30 30 100.0
total 349 554 63.0


" . \n"; \n"; \n"; \n" . \n" . \n" . \n";
line stmt bran cond sub pod time code
1             package WWW::Form;
2              
3 7     7   529829 use strict;
  7         80  
  7         236  
4 7     7   36 use warnings;
  7         12  
  7         193  
5              
6 7     7   182 use 5.014;
  7         24  
7              
8 7     7   3930 use HTML::Entities ();
  7         43447  
  7         32022  
9              
10             our $VERSION = "1.19";
11              
12              
13             sub new {
14 8     8 1 2584 my $class = shift;
15              
16             # Hash that contains various bits of data in regard to the form fields,
17             # i.e. the form field's label, its input type (e.g. radio, text, textarea,
18             # select, etc.) validators to check the user entered input against a
19             # default value to use before the form is submitted and an option group
20             # hash if the type of the form input is select or radio this hash should
21             # be keyed with the values you want to use for the name attributes of your
22             # form inputs
23 8         15 my $fieldsData = shift;
24              
25             # Values to populate value keys of field hashes with generally this will
26             # be a hash of HTTP params needs to have the same keys as fieldsData
27 8   100     31 my $fieldValues = shift || {};
28              
29             # Array ref of field name keys that should be in the order that you want
30             # to display your form inputs
31 8   100     35 my $fieldsOrder = shift || [];
32              
33 8         16 my $self = {};
34              
35 8         21 $self->{fieldsOrder} = $fieldsOrder;
36              
37 8         17 bless($self, $class);
38              
39             # Set up a fields hash ref for the fields, so we will not need
40             # autovivificatiopn later
41 8         33 $self->{fields} = {};
42              
43             # Creates and populates fields hash
44 8         29 $self->_setFields($fieldsData, $fieldValues);
45              
46 8         30 return $self;
47             }
48              
49              
50              
51             sub validateFields {
52 0     0 1 0 my $self = shift;
53              
54             # Initialize hash of valid fields
55 0         0 my %validFields = ();
56              
57             # Init isValid property to 1 that is, the form starts out as being valid
58             # until an invalid field is found, at which point the form gets set to
59             # invalid (i.e., $self->{isValid} = 0)
60 0         0 $self->{isValid} = 1;
61              
62             # Go through all the fields and look to see if they have any validators,
63             # if so check the validators to see if the input is valid, if the field
64             # has no validators then the field is always valid
65 0         0 foreach my $fieldName (keys %{$self->{fields}}) {
  0         0  
66              
67             # Look up hash ref of data for the current field name
68 0         0 my $field = $self->getField($fieldName);
69              
70 0         0 my $fieldValue = $self->getFieldValue($fieldName);
71              
72             # If this field has any validators, run them
73 0 0       0 if (scalar(@{$field->{validators}}) > 0) {
  0         0  
74              
75             # Keeps track of how many validators pass
76 0         0 my $validValidators = 0;
77              
78             # Check the field's validator(s) to see if the user input is valid
79 0         0 foreach my $validator (@{$field->{validators}}) {
  0         0  
80              
81 0 0       0 if ($validator->validate($fieldValue)) {
82             # Increment the validator counter because the current
83             # validator passed, i.e. the form input was good
84 0         0 $validValidators++;
85             }
86             else {
87             # Mark field as invalid so error feedback can be displayed
88             # to the user
89 0         0 $field->{isValid} = 0;
90              
91             # Mark form as invalid because at least one input is not
92             # valid
93 0         0 $self->{isValid} = 0;
94              
95             # Add the validators feedback to the array of feedback for
96             # this field
97 0         0 push @{$field->{feedback}}, $validator->{feedback};
  0         0  
98             }
99             }
100              
101             # Only set the field to valid if ALL of the validators pass
102 0 0       0 if (scalar(@{$field->{validators}}) == $validValidators) {
  0         0  
103 0         0 $field->{isValid} = 1;
104 0         0 $validFields{$fieldName} = $fieldValue;
105             }
106             }
107             else {
108             # This field didn't have any validators so it's ok
109 0         0 $field->{isValid} = 1;
110 0         0 $validFields{$fieldName} = $fieldValue;
111             }
112             }
113              
114             # Return hash ref of valid fields
115 0         0 return \%validFields;
116             }
117              
118              
119             *validate_fields = \&validateFields;
120              
121              
122              
123             sub getFields {
124 0     0 1 0 my $self = shift;
125 0         0 return $self->{fields};
126             }
127              
128              
129             *get_fields = \&getFields;
130              
131              
132              
133             sub resetFields {
134 0     0 1 0 my ($self, %args) = @_;
135 0         0 my $fields = $self->getFields();
136              
137 0         0 for my $fieldName (keys %$fields) {
138 0         0 $self->setFieldValue($fieldName, '');
139              
140             $self->getField($fieldName)->{defaultValue} = ''
141 0 0       0 if ($args{include_defaults});
142             }
143             }
144              
145              
146             *reset_fields = \&resetFields;
147              
148              
149              
150             sub getField {
151 67     67 1 86 my $self = shift;
152 67         80 my $fieldName = shift;
153 67         156 return $self->{fields}{$fieldName};
154             }
155              
156              
157             *get_field = \&getField;
158              
159              
160              
161             sub getFieldErrorFeedback {
162 4     4 1 6 my $self = shift;
163 4         6 my $fieldName = shift;
164              
165 4         7 my $field = $self->getField($fieldName);
166              
167 4 50       8 if ($field->{feedback}) {
168 4         7 return @{$field->{feedback}};
  4         8  
169             }
170             else {
171 0         0 return ();
172             }
173             }
174              
175              
176             *get_field_error_feedback = \&getFieldErrorFeedback;
177              
178              
179              
180             sub getFieldsOrder {
181 4     4 1 8 my $self = shift;
182 4         11 return $self->{fieldsOrder};
183             }
184              
185              
186             *get_fields_order = \&getFieldsOrder;
187              
188              
189              
190             sub getFieldValue {
191 2     2 1 4 my $self = shift;
192 2         3 my $fieldName = shift;
193 2         3 return $self->getField($fieldName)->{value};
194             }
195              
196              
197             *get_field_value = \&getFieldValue;
198              
199              
200              
201             sub isFieldValid {
202 0     0 1 0 my $self = shift;
203 0         0 my $fieldName = shift;
204              
205 0         0 return $self->getField($fieldName)->{isValid};
206             }
207              
208              
209             *is_field_valid = \&isFieldValid;
210              
211              
212              
213             sub getFieldValidators {
214 0     0 1 0 my ($self, $fieldName) = @_;
215 0         0 return $self->getField($fieldName)->{validators};
216             }
217              
218              
219             *get_field_validators = \&getFieldValidators;
220              
221              
222              
223             sub getFieldType {
224 4     4 1 6 my $self = shift;
225 4         5 my $fieldName = shift;
226 4         8 return $self->getField($fieldName)->{type};
227             }
228              
229              
230             *get_field_type = \&getFieldType;
231              
232              
233              
234             sub getFieldLabel {
235 4     4 1 8 my $self = shift;
236 4         7 my $fieldName = shift;
237              
238 4         14 my $field = $self->getField($fieldName);
239              
240 4 50       11 if ($self->getFieldType($fieldName) eq 'checkbox') {
241 0         0 return "';
242             }
243             else {
244 4         12 return $field->{label};
245             }
246             }
247              
248              
249             *get_field_label = \&getFieldLabel;
250              
251              
252              
253             sub getFieldHint {
254 4     4 1 11 my $self = shift;
255 4         5 my $fieldName = shift;
256              
257 4         20 my $field = $self->getField($fieldName);
258              
259 4         8 return $field->{hint};
260             }
261              
262              
263             *get_field_hint = \&getFieldHint;
264              
265              
266              
267             sub setFieldValue {
268 0     0 1 0 my $self = shift;
269 0         0 my $fieldName = shift;
270 0         0 my $newValue = shift;
271              
272 0 0       0 if (my $field = $self->getField($fieldName)) {
273 0         0 $field->{value} = $newValue;
274             #warn("set field value for field: $fieldName to '$new_value'");
275             }
276             else {
277             #warn("could not find field for field name: '$fieldName'");
278             }
279             }
280              
281              
282             *set_field_value = \&setFieldValue;
283              
284              
285              
286             sub isValid {
287 0     0 1 0 my $self = shift;
288 0         0 return $self->{isValid};
289             }
290              
291              
292             *is_valid = \&isValid;
293              
294              
295              
296             sub isSubmitted {
297 0     0 1 0 my $self = shift;
298              
299             # The actual HTTP request method that the form was sent using
300 0         0 my $formRequestMethod = shift;
301              
302             # This should be GET or POST, defaults to POST
303 0   0     0 my $formMethodToCheck = shift || 'POST';
304              
305 0 0       0 if ($formRequestMethod eq $formMethodToCheck) {
306 0         0 return 1;
307             }
308             else {
309 0         0 return 0;
310             }
311             }
312              
313              
314             *is_submitted = \&isSubmitted;
315              
316              
317              
318             # Private method
319             #
320             # Populates fields hash for each field of the form
321             sub _setFields {
322 11     11   7428 my $self = shift;
323 11         19 my $fieldsData = shift;
324 11         17 my $fieldValues = shift;
325              
326             # TODO :
327             # Create a _setField() method that will encapsulate the functionality
328             # inside the loop. This will enable adding more variables to each field
329             # in the sub-classes more easily.
330              
331 11         21 foreach my $fieldName (keys %{$fieldsData}) {
  11         42  
332             $self->_setField(
333             'name' => $fieldName,
334             'params' => $fieldsData->{$fieldName},
335 24         70 'value' => $fieldValues->{$fieldName}
336             );
337             }
338             }
339              
340             sub _getFieldInitParams
341             {
342 26     26   3968 my $self = shift;
343              
344 26         63 my %args = (@_);
345              
346 26         43 my $fieldName = $args{name};
347 26         36 my $params = $args{params};
348 26         38 my $user_given_field_value = $args{value};
349              
350             # This is the output parameters that we eventually place under
351             # $out_params->. It is declared it so it can later be filled
352             # in by a different function other
353 26         38 my $out_params = {};
354              
355             # Use the supplied field value if one is given. Generally the supplied
356             # data will be a hash of HTTP POST data
357 26         36 my $fieldValue = '';
358              
359             # Only use the default value of a check box if the form has been
360             # submitted, that is, the default value should be the value that you
361             # want to show up in the POST data if the checkbox is selected when
362             # the form is submitted
363 26 100       66 if ($params->{type} eq 'checkbox') {
364              
365             # If the checkbox was selected then we're going to use the default
366             # value for the checkbox input's value in our WWW::Form object, if
367             # the checkbox was not selected and the form was submitted that
368             # variable will not show up in the hash of HTTP variables
369 2 100       6 if ($user_given_field_value) {
370 1         2 $fieldValue = $params->{defaultValue};
371             }
372              
373             # See if this checkbox should be checked by default
374             $out_params->{defaultChecked} =
375 2         5 $params->{defaultChecked};
376             }
377             else {
378             # If a key exists in the $fieldValues hashref, use that value
379             # instead of the default, we generally want to favor displaying
380             # user entered values than defaults
381 24 100       43 if (defined($user_given_field_value)) {
382 18         32 $fieldValue = $user_given_field_value;
383             }
384             else {
385 6         9 $fieldValue = $params->{defaultValue};
386             }
387             }
388              
389             # Value suitable for displaying to users as a label for a form input,
390             # e.g. 'Email address', 'Full name', 'Street address', 'Phone number',
391             # etc.
392 26         48 $out_params->{label} = $params->{label};
393              
394             # Holds the value that the user enters after the form is submitted
395 26         41 $out_params->{value} = $fieldValue;
396              
397             # The value to pre-populate a form input with before the form is
398             # submitted, the only exception is a checkbox form input in the case
399             # of a checkbox, the default value will be the value of the checkbox
400             # input if the check box is selected and the form is submitted, see
401             # form_test.pl for an example
402             $out_params->{defaultValue} =
403 26         40 $params->{defaultValue};
404              
405             # The validators for this field, validators are used to test user
406             # entered form input to make sure that it the user entered data is
407             # acceptable
408             $out_params->{validators} =
409 26         35 \@{$params->{validators}};
  26         72  
410              
411             # Type of the form input, i.e. 'radio', 'text', 'select', 'checkbox',
412             # etc. this is mainly used to determine what type of HTML method
413             # should be used to display the form input in a web page
414 26         41 $out_params->{type} = $params->{type};
415              
416             # If any validators fail, this property will contain the error
417             # feedback associated with those failing validators
418 26         48 $out_params->{feedback} = [];
419              
420             # If the input type is a select box or a radio button then we need an
421             # array of labels and values for the radio button group or select box
422             # option groups
423 26 50       58 if (my $optionsGroup = $params->{optionsGroup}) {
424 0         0 $out_params->{optionsGroup} = \@{$optionsGroup};
  0         0  
425             }
426              
427             # Arbitrary HTML attributes that will be used when the field's input
428             # element is displayed.
429             $out_params->{extraAttributes} =
430 26   50     115 ($params->{extraAttributes} || "");
431              
432             # Add the hint
433             # 2004-Jan-04 - Added by Shlomi Fish:
434             # Ben, no. Actually it's a hint that will always be displayed below
435             # the table row to instruct the users what to input there. For instance
436             # +----------+---------------------------+
437             # | City: | [================] |
438             # +----------+---------------------------+
439             # | Input the city in which you live |
440             # | in. |
441             # +---------------------------------------
442             # So "Input the city..." would be the hint.
443 26 100       59 if (my $hint = $params->{hint})
444             {
445 3         10 $out_params->{hint} = $hint;
446             }
447              
448             # Add the container_attributes. These are HTML attributes that would
449             # be added to the rows of this HTML row.
450 26 50       122 if (my $attribs = $params->{container_attributes})
451             {
452 0         0 $out_params->{container_attributes} = $attribs;
453             }
454              
455             # Add the hint_container_attributes. These are HTML attributes that
456             # would be added to the Hint row of this HTML row.
457 26 50       63 if (my $attribs = $params->{hint_container_attributes})
458             {
459 0         0 $out_params->{hint_container_attributes} = $attribs;
460             }
461              
462 26         69 return $out_params;
463             }
464              
465             # This function should not be left alone in sub-classing.
466             # Instead override _getFieldInitParams() to add your own parameters
467             # there.
468             sub _setField
469             {
470 25     25   2864 my $self = shift;
471              
472 25         77 my %args = (@_);
473              
474 25         71 my $params = $self->_getFieldInitParams(%args);
475              
476 25         70 $self->{fields}{$args{name}} = $params;
477              
478 25         66 return $self;
479             }
480              
481              
482             sub asString {
483 0     0 1 0 my $self = shift;
484 0         0 require Data::Dumper;
485 0         0 return Data::Dumper::Dumper($self);
486             }
487              
488              
489             *as_string = \&asString;
490              
491             sub _getFieldType
492             {
493 19     19   28 my $self = shift;
494 19         24 my $fieldName = shift;
495              
496 19         32 return $self->getField($fieldName)->{type};
497             }
498              
499             #-----------------------------------------------------------------------------
500             # Convenience methods for displaying HTML form data including form inputs,
501             # labels, and error feedback
502             #
503             # Note: You do not need to use these methods to display your form inputs, but
504             # they should be reasonably flexible enough to handle most cases
505             #-----------------------------------------------------------------------------
506              
507              
508             sub getFieldFormInputHTML {
509 4     4 1 10 my $self = shift;
510              
511             # The value of the HTML name attribute of the form field
512 4         7 my $fieldName = shift;
513              
514             # A string that can contain an arbitrary number of HTML attribute
515             # name=value pairs, this lets you apply CSS classes to form inputs
516             # or control the size of your text inputs, for example
517 4   50     14 my $attributesString = shift || '';
518              
519 4         7 my $type = $self->_getFieldType($fieldName);
520              
521 4 100       57 if ($type =~ /text$|password|hidden|file/) {
    50          
    50          
    50          
    50          
522              
523 2         7 return $self->_getInputHTML($fieldName, $attributesString);
524              
525             }
526             elsif ($type eq 'checkbox') {
527              
528 0         0 return $self->_getCheckBoxHTML($fieldName, $attributesString);
529              
530             }
531             elsif ($type eq 'radio') {
532              
533 0         0 return $self->_getRadioButtonHTML($fieldName, $attributesString);
534              
535             }
536             elsif ($type eq 'select') {
537              
538 0         0 return $self->_getSelectBoxHTML($fieldName, $attributesString);
539              
540             }
541             elsif ($type eq 'textarea') {
542              
543 2         8 return $self->_getTextAreaHTML($fieldName, $attributesString);
544             }
545             }
546              
547              
548             *get_field_form_input_HTML = \&getFieldFormInputHTML;
549              
550              
551              
552             sub getFieldLabelTdHTML
553             {
554 4     4 1 11 return "";
555             }
556              
557              
558             sub getFieldInputTdHTML
559             {
560 4     4 1 47 return "";
561             }
562              
563              
564             sub renderFieldHTMLRow
565             {
566 4     4 1 6 my $self = shift;
567 4         15 my (%args) = (@_);
568 4         5 my $fieldName = $args{'fieldName'};
569 4         8 my $attributesString = $args{'attributesString'};
570 4         6 my $tr_attr_string = $args{'trAttrString'};
571             return
572 4         11 "" . $self->getFieldLabelTdHTML($fieldName) .
573             $self->getFieldLabel($fieldName) . "
574             $self->getFieldInputTdHTML($fieldName) . $self->getFieldFormInputHTML(
575             $fieldName,
576             $attributesString
577             )
578             . "
579             }
580              
581              
582             sub renderHintHTMLRow
583             {
584 4     4 1 6 my $self = shift;
585 4         8 my $fieldName = shift;
586 4         10 my (%func_args) = (@_);
587              
588 4         8 my $field = $self->getField($fieldName);
589              
590 4         7 my $tr_attributes = $self->_getTrAttributes($fieldName);
591              
592 4         8 my $form_args = $func_args{'form_args'};
593              
594 4         7 my $hint = $self->getFieldHint($fieldName);
595              
596 4 50       11 if (defined($hint)) {
597 0         0 my %hint_attributes = ();
598 0         0 my $hint_attributes = $form_args->{'hint_container_attributes'};
599              
600 0 0       0 if (defined($hint_attributes)) {
601 0         0 %hint_attributes = (%hint_attributes, %$hint_attributes);
602             }
603              
604 0         0 %hint_attributes = (%hint_attributes, %$tr_attributes);
605              
606 0 0       0 if (exists($field->{hint_container_attributes})) {
607 0         0 %hint_attributes = (%hint_attributes, %{$field->{hint_container_attributes}});
  0         0  
608             }
609              
610 0         0 my $hint_attr_string = $self->_render_attributes(\%hint_attributes);
611 0         0 return "$hint
612             }
613             else
614             {
615 4         10 return "";
616             }
617             }
618              
619             sub _getTrAttributes
620             {
621 8     8   14 my $self = shift;
622 8         10 my $fieldName = shift;
623              
624 8         10 my %tr_attributes = ();
625              
626 8         12 my $field = $self->getField($fieldName);
627              
628 8 50       19 if (exists($field->{container_attributes})) {
629 0         0 %tr_attributes = (%tr_attributes, %{$field->{container_attributes}});
  0         0  
630             }
631 8         15 return \%tr_attributes;
632             }
633              
634             sub _render_attributes {
635 8     8   2165 my $self = shift;
636 8         23 my $attribs = shift;
637              
638             # We sort the keys to produce reproducible output on perl 5.8.1 and above
639             # where the order of the hash keys is not deterministic
640             return join("",
641 6         47 map { " $_=\"" . $self->_escapeValue($attribs->{$_}) . "\"" }
642 8         34 (sort {$a cmp $b} keys(%$attribs))
  3         8  
643             );
644             }
645              
646             sub _getTrAttrString
647             {
648 4     4   8 my $self = shift;
649 4         5 my $fieldName = shift;
650 4         10 return $self->_render_attributes($self->_getTrAttributes($fieldName));
651             }
652              
653              
654             sub getFieldHTMLRow {
655 5     5 1 11 my $self = shift;
656 5         8 my $fieldName = shift;
657              
658 5 100       13 if ($self->_getFieldType($fieldName) eq "hidden")
659             {
660 1         7 return $self->_getHiddenFieldHTMLRow($fieldName);
661             }
662              
663 4         8 my %func_args = (@_);
664 4         6 my $attributesString = $func_args{'attributesString'};
665 4         6 my $form_args = $func_args{'form_args'};
666              
667 4         8 my $field = $self->getField($fieldName);
668              
669 4   33     19 $attributesString ||= $field->{extraAttributes};
670              
671 4         9 my @feedback = $self->getFieldErrorFeedback($fieldName);
672              
673 4         6 my $html = "";
674              
675 4         24 my $tr_attr_string = $self->_getTrAttrString($fieldName);
676              
677 4         11 foreach my $error (@feedback) {
678 0         0 $html .= ""
679             . "$error"
680             . "
681             }
682              
683 4         20 $html .= $self->renderFieldHTMLRow(
684             'fieldName' => $fieldName,
685             'attributesString' => $attributesString,
686             'trAttrString' => $tr_attr_string,
687             );
688              
689 4         14 $html .=
690             $self->renderHintHTMLRow(
691             $fieldName,
692             'form_args' => $form_args,
693             );
694              
695 4         17 return $html;
696             }
697              
698              
699             *get_field_HTML_row = \&getFieldHTMLRow;
700              
701              
702             sub getFieldHTMLRowNoHidden
703             {
704 5     5 1 7 my $self = shift;
705 5         7 my $fieldName = shift;
706              
707 5 100       9 if ($self->_getFieldType($fieldName) eq "hidden")
708             {
709 1         3 return "";
710             }
711             else
712             {
713 4         12 return $self->getFieldHTMLRow($fieldName);
714             }
715             }
716              
717              
718             *get_field_HTML_row_no_hidden = \&getFieldHTMLRowNoHidden;
719              
720              
721             sub getFieldFeedbackHTML {
722 0     0 1 0 my $self = shift;
723 0         0 my $fieldName = shift;
724              
725 0         0 my @feedback = $self->getFieldErrorFeedback($fieldName);
726              
727 0         0 my $feedbackHTML = '';
728              
729 0         0 foreach my $fieldFeedback (@feedback) {
730 0         0 $feedbackHTML .= "
731 0         0 $feedbackHTML .= $fieldFeedback . "\n\n";
732             }
733              
734 0         0 return $feedbackHTML;
735             }
736              
737              
738             *get_field_feedback_HTML = \&getFieldFeedbackHTML;
739              
740              
741              
742             sub startForm {
743 2     2 1 6 my ($self, %args) = @_;
744              
745 2   50     9 my $method = $args{method} || 'post';
746 2   50     9 my $attributes = $args{attributes} || {};
747              
748 2         16 my $name_attributes = '';
749 2 50       14 if ($args{name}) {
750 0         0 $name_attributes = " name='$args{name}' id='$args{name}'";
751             }
752              
753 2         11 my $html = "
754             . " method='$method'$name_attributes";
755              
756             # If this form contains a file input then set the enctype attribute
757             # to multipart/form-data
758 2 50       5 if ($args{is_file_upload}) {
759 0         0 $html .= " enctype='multipart/form-data'";
760             }
761              
762 2         5 for my $attribute (keys %{$attributes}) {
  2         6  
763 0         0 $html .= " $attribute='$attributes->{$attribute}'";
764             }
765              
766             # Chop off last space if there is one
767 2         9 $html =~ s/\s$//;
768              
769 2         10 return $html . '>';
770             }
771              
772              
773             *start_form = \&startForm;
774              
775              
776              
777             sub endForm {
778 2     2 1 3 my $self = shift;
779 2         17 return '';
780             }
781              
782              
783             *end_form = \&endForm;
784              
785              
786              
787             sub getFormHTML {
788 2     2 1 15 my ($self, %args) = @_;
789              
790 2         9 my $html = $self->startForm(%args) . "\n";
791              
792 2         7 $html .= $self->getHiddenFieldsHTML();
793 2         4 $html .= "\n";
794              
795             # Go through all of our form fields and build an HTML input for each field
796 2         4 for my $fieldName (@{$self->getFieldsOrder()}) {
  2         16  
797             #warn("field name is: $fieldName");
798 5         16 $html .= $self->getFieldHTMLRowNoHidden(
799             $fieldName,
800             'form_args' => \%args,
801             );
802             }
803              
804 2         4 $html .= "
\n";
805              
806 2 50       8 unless ($args{submit_label}) {
807 2         5 $args{submit_label} = 'Submit';
808             }
809              
810 2 50       6 unless ($args{submit_name}) {
811 2         3 $args{submit_name} = 'submit';
812             }
813              
814             # Add submit button
815 2         21 $html .= "

" . $self->_getSubmitButtonHTML(%args) . "

\n";
816              
817 2         7 return $html . $self->endForm() . "\n";
818             }
819              
820              
821             *get_form_HTML = \&getFormHTML;
822              
823              
824             sub getHiddenFieldsHTML
825             {
826 2     2 1 4 my $self = shift;
827              
828             return
829             join("",
830 1         5 (map { $self->_getInputHTML($_, "") . "\n" }
831 5         10 grep { $self->_getFieldType($_) eq "hidden" }
832 2         4 (@{$self->getFieldsOrder()}))
  2         12  
833             );
834             }
835              
836              
837             *get_hidden_fields_HTML = \&getHiddenFieldsHTML;
838              
839             sub _getHiddenFieldHTMLRow
840             {
841 1     1   2 my $self = shift;
842 1         2 my $fieldName = shift;
843 1         4 return "
844             "
845             "" . $self->_getInputHTML($fieldName, "") ."
846             "
847             }
848              
849             #-----------------------------------------------------------------------------
850             # More private methods
851             #-----------------------------------------------------------------------------
852              
853             # Returns HTML to display a form text input.
854             sub _getInputHTML {
855 8     8   739 my $self = shift;
856 8         14 my $fieldName = shift;
857 8         13 my $attributesString = shift;
858              
859 8         21 my $field = $self->getField($fieldName);
860              
861 8         30 my $inputHTML = "
862             . " name='$fieldName' id='$fieldName' value=\"";
863              
864 8         13 my $value_to_put;
865 8 100       33 if ($field->{type} eq 'checkbox') {
866 2         17 $value_to_put = $field->{defaultValue};
867             }
868             else {
869 6         13 $value_to_put = $field->{value};
870             }
871 8         21 $inputHTML .= $self->_escapeValue($value_to_put);
872              
873 8         174 $inputHTML .= "\"" . $attributesString . " />";
874              
875 8         36 return $inputHTML;
876             }
877              
878              
879              
880             sub getSubmitButtonHTML {
881 2     2 1 7 my ($class, %args) = @_;
882              
883 2 50       7 if (exists($args{buttons})) {
884 0         0 my $xhtml;
885 0         0 foreach my $button (@{$args{buttons}}) {
  0         0  
886 0         0 $xhtml .= $class->_getSubmitButtonHTML(%$button);
887             }
888 0         0 return $xhtml;
889             }
890              
891 2   50     12 my $type = $args{submit_type} || 'submit';
892              
893             # Optional param that specifies an image for the submit button, this
894             # should only be used if the type is 'image'
895 2   50     9 my $img_src = $args{submit_src} || '';
896              
897 2   50     5 my $label = $args{submit_label} || 'Submit';
898              
899 2         5 my $xhtml = "
900              
901             # If the type was specified as 'image' add the src attribute, otherwise
902             # add a value attribute
903 2 50       6 if ($type eq 'image') {
904             # Warn the developer if type is 'image' and a src key wasn't specified
905 0 0       0 unless ($img_src) {
906 0         0 warn(
907             "Won't be able to display image submit button properly" .
908             " because src for image was not specified"
909             );
910             }
911              
912 0         0 $xhtml .= " src='$img_src'";
913             }
914             else {
915 2         6 $xhtml .= " value='$label'";
916             }
917              
918 2   50     10 my $attributes = $args{submit_attributes} || {};
919              
920 2 50       6 if ($args{submit_class}) {
921             # Add class attribute if it's there
922 0         0 $xhtml .= " class='$args{submit_class}'";
923             # Add id attribute that uses same value as class, eventually should
924             # use separate params, though!
925 0         0 $xhtml .= " id='$args{submit_class}'";
926             }
927              
928 2 50       13 if ($args{submit_name}) {
929 2         8 $xhtml .= " name='$args{submit_name}'";
930              
931             }
932              
933             # Add any other attribute name value pairs that the developer may want to
934             # enter
935 2         3 for my $attribute (keys %{$attributes}) {
  2         7  
936 0         0 $xhtml .= " $attribute='$attributes->{$attribute}'";
937             }
938              
939 2         8 $xhtml =~ s/\s$//; # Remove trailing whitespace
940 2         3 $xhtml .= " />\n";
941 2         10 return $xhtml;
942             }
943              
944              
945             # We have lots of names for this method. It used to be private, but now it's
946             # public.
947             *_get_submit_button_HTML = \&getSubmitButtonHTML;
948              
949              
950             *get_submit_button_HTML = \&getSubmitButtonHTML;
951             *_getSubmitButtonHTML = \&getSubmitButtonHTML;
952              
953              
954             # Returns HTML to display a checkbox.
955             sub _getCheckBoxHTML {
956 2     2   596 my $self = shift;
957 2         3 my $fieldName = shift;
958 2         4 my $attributesString = shift;
959              
960 2         4 my $field = $self->getField($fieldName);
961              
962 2 100 66     4 if ($self->getFieldValue($fieldName) || $field->{defaultChecked}) {
963 1         2 $attributesString .= " checked='checked'";
964             }
965              
966 2         5 return $self->_getInputHTML($fieldName, $attributesString);
967             }
968              
969             # Returns a radio button group
970             sub _getRadioButtonHTML {
971 0     0   0 my $self = shift;
972 0         0 my $fieldName = shift;
973 0         0 my $attributesString = shift;
974              
975 0         0 my $field = $self->getField($fieldName);
976              
977             # Get the select boxes' list of options
978 0         0 my $group = $field->{optionsGroup};
979              
980 0         0 my $inputHTML = '';
981              
982 0 0       0 if ($group) {
983 0         0 foreach my $option (@{$group}) {
  0         0  
984 0         0 $inputHTML .= '
985              
986             # Reset for each radio button in the group
987 0         0 my $isChecked = '';
988              
989 0         0 my $value = $option->{value};
990 0         0 my $label = $option->{label};
991              
992 0 0       0 if ($value eq $self->getFieldValue($fieldName)) {
993 0         0 $isChecked = " checked='checked'";
994             }
995              
996 0         0 $inputHTML .= "
997             . " name='$fieldName'";
998              
999 0         0 $inputHTML .= " value=\"". $self->_escapeValue($value) . "\" ";
1000 0         0 $inputHTML .= $attributesString
1001             . $isChecked
1002             . " /> $label
";
1003             }
1004             }
1005             else {
1006 0         0 warn(
1007             "No option group found for radio button group named: '$fieldName'"
1008             );
1009             }
1010 0         0 return $inputHTML;
1011             }
1012              
1013             # Returns HTML to display a textarea.
1014             sub _getTextAreaHTML {
1015 3     3   10 my $self = shift;
1016 3         6 my $fieldName = shift;
1017 3         5 my $attributesString = shift;
1018              
1019 3         8 my $field = $self->getField($fieldName);
1020              
1021 3         11 my $textarea = "";
1027              
1028 3         23 return $textarea;
1029             }
1030              
1031             # Returns HTML to display a select box.
1032             sub _getSelectBoxHTML {
1033 0     0   0 my $self = shift;
1034 0         0 my $fieldName = shift;
1035 0         0 my $attributesString = shift;
1036              
1037 0         0 my $html = "
1038              
1039             # Get the select boxes' list of options
1040 0         0 my $group = $self->getField($fieldName)->{optionsGroup};
1041              
1042 0 0       0 if ($group) {
1043 0         0 foreach my $option (@{$group}) {
  0         0  
1044 0         0 my $value = $option->{value};
1045 0         0 my $label = $option->{label};
1046              
1047             # If the current user value is equal to the current option value
1048             # then the current option should be selected in the form
1049 0         0 my $isSelected;
1050              
1051 0 0       0 if ($value eq $self->getField($fieldName)->{value}) {
1052 0         0 $isSelected = " selected='selected'";
1053             }
1054             else {
1055 0         0 $isSelected = "";
1056             }
1057 0         0 $html .= "
1058             . "\"${isSelected}>$label\n";
1059             }
1060             }
1061             else {
1062 0         0 warn("No option group found for select box named: '$fieldName'");
1063             }
1064              
1065 0         0 $html .= "\n";
1066 0         0 return $html;
1067             }
1068              
1069             sub _escapeValue {
1070 17     17   28 my $self = shift;
1071 17         24 my $string = shift;
1072 17         61 return HTML::Entities::encode_entities($string);
1073             }
1074              
1075             1;
1076              
1077             __END__