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

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

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