File Coverage

blib/lib/Tags/HTML/Form.pm
Criterion Covered Total %
statement 93 107 86.9
branch 34 72 47.2
condition 11 24 45.8
subroutine 15 18 83.3
pod 1 1 100.0
total 154 222 69.3


line stmt bran cond sub pod time code
1              
2             use base qw(Tags::HTML);
3 5     5   158646 use strict;
  5         51  
  5         2373  
4 5     5   96618 use warnings;
  5         10  
  5         97  
5 5     5   23  
  5         9  
  5         135  
6             use Class::Utils qw(set_params split_params);
7 5     5   26 use Data::HTML::Button;
  5         8  
  5         197  
8 5     5   1889 use Data::HTML::Form;
  5         21394  
  5         149  
9 5     5   1335 use Error::Pure qw(err);
  5         2979  
  5         144  
10 5     5   30 use List::Util qw(first);
  5         9  
  5         203  
11 5     5   35 use Scalar::Util qw(blessed);
  5         12  
  5         295  
12 5     5   30 use Tags::HTML::Form::Input;
  5         10  
  5         176  
13 5     5   2220 use Tags::HTML::Form::Select;
  5         13  
  5         133  
14 5     5   2049  
  5         14  
  5         6955  
15             our $VERSION = 0.06;
16              
17             # Constructor.
18             my ($class, @params) = @_;
19              
20 17     17 1 31349 # Create object.
21             my ($object_params_ar, $other_params_ar) = split_params(
22             ['form', 'input', 'select', 'submit'], @params);
23 17         76 my $self = $class->SUPER::new(@{$other_params_ar});
24              
25 17         460 # Form.
  17         66  
26             $self->{'form'} = Data::HTML::Form->new(
27             'css_class' => 'form',
28 17         490 );
29              
30             # Input object.
31             $self->{'input'} = undef;
32              
33 17         1214 # Select object.
34             $self->{'select'} = undef;
35              
36 17         33 # Submit.
37             $self->{'submit'} = Data::HTML::Button->new(
38             'data' => [
39 17         78 ['d', 'Save'],
40             ],
41             'data_type' => 'tags',
42             'type' => 'submit',
43             );
44              
45             # Process params.
46             set_params($self, @{$object_params_ar});
47              
48 17         2443 # Check form.
  17         57  
49             if (! defined $self->{'form'}) {
50             err "Parameter 'form' is required.";
51 17 100       194 }
52 1         5 if (! blessed($self->{'form'})
53             || ! $self->{'form'}->isa('Data::HTML::Form')) {
54 16 100 66     137  
55             err "Parameter 'form' must be a 'Data::HTML::Form' instance.";
56             }
57 1         5 if (! defined $self->{'form'}->{'css_class'}) {
58             err "Parameter 'form' must define 'css_class' parameter.";
59 15 100       48 }
60 1         5  
61             # Check submit.
62             if (! defined $self->{'submit'}) {
63             err "Parameter 'submit' is required.";
64 14 100       32 }
65 1         4 if (! blessed($self->{'submit'})
66             || (! $self->{'submit'}->isa('Data::HTML::Form::Input')
67 13 100 66     142 && ! $self->{'submit'}->isa('Data::HTML::Button'))) {
      100        
68              
69             err "Parameter 'submit' must be a 'Data::HTML::Form::Input' instance.";
70             }
71 1         3 if ($self->{'submit'}->type ne 'submit') {
72             err "Parameter 'submit' instance has bad type.";
73 12 100       46 }
74 1         13  
75             # Input object.
76             if (! defined $self->{'input'}) {
77             $self->{'input'} = Tags::HTML::Form::Input->new(
78 11 50       82 'css' => $self->{'css'},
79             'tags' => $self->{'tags'},
80             );
81 11         49 } else {
82             if (! blessed($self->{'input'}) || $self->{'input'}->isa('Tags::HTML::Form::Input')) {
83             err "Parameter 'input' must be a 'Tags::HTML::Form::Input' instance.";
84 0 0 0     0 }
85 0         0 }
86              
87             # Select object.
88             if (! defined $self->{'select'}) {
89             $self->{'select'} = Tags::HTML::Form::Select->new(
90 11 50       364 'css' => $self->{'css'},
91             'tags' => $self->{'tags'},
92             ),
93 11         47 } else {
94             if (! blessed($self->{'select'}) || $self->{'select'}->isa('Tags::HTML::Form::Select')) {
95             err "Parameter 'select' must be a 'Tags::HTML::Form::Select' instance.";
96 0 0 0     0 }
97 0         0 }
98              
99             # Object.
100             return $self;
101             }
102 11         120  
103             # Process 'Tags'.
104             my ($self, @fields) = @_;
105              
106             # Check fields.
107 6     6   254 foreach my $field (@fields) {
108             if (! defined $field
109             || ! blessed($field)
110 6         12 || (! $field->isa('Data::HTML::Form::Input')
111 2 50 66     19 && ! $field->isa('Data::HTML::Textarea')
      0        
      66        
112             && ! $field->isa('Data::HTML::Form::Select'))) {
113              
114             err "Form item must be a 'Data::HTML::Form::Input', ".
115             "'Data::HTML::Textarea' or 'Data::HTML::Form::Select' instance.";
116             }
117 1         6 }
118              
119             $self->{'tags'}->put(
120             ['b', 'form'],
121             defined $self->{'form'}->css_class ? (
122             ['a', 'class', $self->{'form'}->css_class],
123             ) : (),
124             defined $self->{'form'}->action ? (
125             ['a', 'action', $self->{'form'}->action],
126             ) : (),
127             ['a', 'method', $self->{'form'}->method],
128              
129             defined $self->{'form'}->{'label'} ? (
130             ['b', 'fieldset'],
131             ['b', 'legend'],
132             ['d', $self->{'form'}->{'label'}],
133             ['e', 'legend'],
134             ) : (),
135 5 50       21 );
    50          
    100          
136              
137             if (@fields) {
138             $self->{'tags'}->put(
139             ['b', 'p'],
140 5 100       707 );
141 1         4 }
142              
143             foreach my $field (@fields) {
144             $self->{'tags'}->put(
145             defined $field->label ? (
146 5         43 ['b', 'label'],
147             $field->id ? (
148             ['a', 'for', $field->id],
149             ) : (),
150             ['d', $field->label],
151             $field->required ? (
152             ['b', 'span'],
153             ['a', 'class', $self->{'form'}->css_class.'-required'],
154             ['d', '*'],
155             ['e', 'span'],
156 1 0       4 ) : (),
    0          
    50          
157             ['e', 'label'],
158             ) : (),
159             );
160              
161             if ($field->isa('Data::HTML::Form::Input')) {
162             $self->{'input'}->process($field);
163             } elsif ($field->isa('Data::HTML::Form::Select')) {
164 1 50       19 $self->{'select'}->process($field);
    0          
165 1         4 } else {
166             $self->_tags_textarea($field);
167 0         0 }
168             }
169 0         0  
170             if (@fields) {
171             $self->{'tags'}->put(
172             ['e', 'p'],
173 5 100       22 );
174 1         4 }
175              
176             $self->{'tags'}->put(
177             ['b', 'p'],
178             );
179 5         52 if ($self->{'submit'}->isa('Data::HTML::Form::Input')) {
180             $self->{'input'}->process($self->{'submit'});
181             } else {
182 5 100       181 $self->_tags_button($self->{'submit'});
183 1         7 }
184             $self->{'tags'}->put(
185 4         12 ['e', 'p'],
186              
187             defined $self->{'form'}->{'label'} ? (
188             ['e', 'fieldset'],
189             ) : (),
190 5 100       23 ['e', 'form'],
191             );
192              
193             return;
194             }
195              
196 5         355 my ($self, @fields) = @_;
197              
198             $self->{'css'}->put(
199             ['s', '.'.$self->{'form'}->css_class],
200 1     1   16 ['d', 'border-radius', '5px'],
201             ['d', 'background-color', '#f2f2f2'],
202             ['d', 'padding', '20px'],
203             ['e'],
204              
205             ['s', '.'.$self->{'form'}->css_class.' textarea'],
206             ['d', 'width', '100%'],
207             ['d', 'padding', '12px 20px'],
208             ['d', 'margin', '8px 0'],
209             ['d', 'display', 'inline-block'],
210             ['d', 'border', '1px solid #ccc'],
211             ['d', 'border-radius', '4px'],
212             ['d', 'box-sizing', 'border-box'],
213             ['e'],
214              
215             ['s', '.'.$self->{'form'}->css_class.'-required'],
216             ['d', 'color', 'red'],
217             ['e'],
218             );
219 1         4  
220             # TODO Different objects and different CSS?
221             my $first_input = first { ref $_ eq 'Data::HTML::Form::Input' } @fields;
222             if (defined $first_input) {
223             $self->{'input'}->process_css($first_input);
224             }
225 1     0   494 my $first_select = first { ref $_ eq 'Data::HTML::Form::Select' } @fields;
  0         0  
226 1 50       6 if (defined $first_select) {
227 0         0 $self->{'select'}->process_css($first_select);
228             }
229 1     0   4  
  0         0  
230 1 50       5 return;
231 0         0 }
232              
233             my ($self, $object) = @_;
234 1         3  
235             $self->{'tags'}->put(
236             ['b', 'button'],
237             ['a', 'type', $object->type],
238 4     4   7 defined $object->name ? (
239             ['a', 'name', $object->name],
240 4 50       14 ) : (),
    50          
241             defined $object->value ? (
242             ['a', 'value', $object->value],
243             ) : (),
244             );
245             if ($object->data_type eq 'tags') {
246             $self->{'tags'}->put(@{$object->data});
247             } else {
248             $self->{'tags'}->put(
249             ['d', $object->data],
250 4 50       278 );
251 4         18 }
  4         11  
252             $self->{'tags'}->put(
253 0         0 ['e', 'button'],
254             );
255              
256             return;
257 4         133 }
258              
259             my ($self, $object) = @_;
260              
261 4         146 $self->{'tags'}->put(
262             ['b', 'textarea'],
263             defined $object->css_class ? (
264             ['a', 'class', $object->css_class],
265 0     0     ) : (),
266             defined $object->id ? (
267 0 0         ['a', 'name', $object->id],
    0          
    0          
    0          
    0          
    0          
    0          
    0          
268             ['a', 'id', $object->id],
269             ) : (),
270             defined $object->placeholder ? (
271             ['a', 'placeholder', $object->placeholder],
272             ) : (),
273             defined $object->readonly ? (
274             ['a', 'readonly', 'readonly'],
275             ) : (),
276             defined $object->disabled ? (
277             ['a', 'disabled', 'disabled'],
278             ) : (),
279             defined $object->cols ? (
280             ['a', 'cols', $object->cols],
281             ) : (),
282             defined $object->rows ? (
283             ['a', 'rows', $object->rows],
284             ) : (),
285             defined $object->value ? (
286             ['d', $object->value],
287             ) : (),
288             ['e', 'textarea'],
289             );
290              
291             return;
292             }
293              
294             1;
295              
296              
297 0           =pod
298              
299             =encoding utf8
300              
301             =head1 NAME
302              
303             Tags::HTML::Form - Tags helper for form.
304              
305             =head1 SYNOPSIS
306              
307             use Tags::HTML::Form;
308              
309             my $obj = Tags::HTML::Form->new(%params);
310             $obj->process(@fields);
311             $obj->process_css;
312              
313             =head1 METHODS
314              
315             =head2 C<new>
316              
317             my $obj = Tags::HTML::Form->new(%params);
318              
319             Constructor.
320              
321             =over 8
322              
323             =item * C<css>
324              
325             'CSS::Struct::Output' object for L<process_css> processing.
326              
327             Default value is undef.
328              
329             =item * C<form>
330              
331             Data object for form.
332              
333             Could ve a 'Data::HTML::Form' instance.
334              
335             Default value is instance with 'form' css class.
336              
337             =item * C<submit>
338              
339             Data object for submit.
340              
341             Could be a 'Data::HTML::Form::Input' or 'Data::HTML::Button' instance.
342              
343             Default value is instance with 'Save' submit value.
344              
345             =item * C<tags>
346              
347             'Tags::Output' object.
348              
349             Default value is undef.
350              
351             =back
352              
353             =head2 C<process>
354              
355             $obj->process(@fields);
356              
357             Process Tags structure for fields defined in C<@fields> to output.
358              
359             Accepted items in C<@fields> are objects:
360              
361             =over
362              
363             =item * L<Data::HTML::Form::Input>
364              
365             =item * L<Data::HTML::Textarea>
366              
367             =back
368              
369             Returns undef.
370              
371             =head2 C<process_css>
372              
373             $obj->process_css;
374              
375             Process CSS::Struct structure for output.
376              
377             Returns undef.
378              
379             =head1 ERRORS
380              
381             new():
382             From Class::Utils::set_params():
383             Unknown parameter '%s'.
384             From Tags::HTML::new():
385             Parameter 'css' must be a 'CSS::Struct::Output::*' class.
386             Parameter 'tags' must be a 'Tags::Output::*' class.
387             Parameter 'form' is required.
388             Parameter 'form' must be a 'Data::HTML::Form' instance.
389             Parameter 'form' must define 'css_class' parameter.
390             Parameter 'input' must be a 'Tags::HTML::Form::Input' instance.
391             Parameter 'submit' instance has bad type.
392             Parameter 'submit' is required.
393             Parameter 'submit' must be a 'Data::HTML::Form::Input' instance.
394              
395             process():
396             From Tags::HTML::process():
397             Parameter 'tags' isn't defined.
398             Form item must be a 'Data::HTML::Form::Input' instance.
399              
400             process_css():
401             From Tags::HTML::process_css():
402             Parameter 'css' isn't defined.
403              
404             =head1 EXAMPLE
405              
406             =for comment filename=default_form.pl
407              
408             use strict;
409             use warnings;
410              
411             use CSS::Struct::Output::Indent;
412             use Tags::HTML::Form;
413             use Tags::Output::Indent;
414              
415             # Object.
416             my $css = CSS::Struct::Output::Indent->new;
417             my $tags = Tags::Output::Indent->new;
418             my $obj = Tags::HTML::Form->new(
419             'css' => $css,
420             'tags' => $tags,
421             );
422              
423             # Process form.
424             $obj->process;
425             $obj->process_css;
426              
427             # Print out.
428             print $tags->flush;
429             print "\n\n";
430             print $css->flush;
431              
432             # Output:
433             # <form class="form" method="GET">
434             # <p>
435             # <button type="submit">
436             # Save
437             # </button>
438             # </p>
439             # </form>
440             #
441             # .form {
442             # border-radius: 5px;
443             # background-color: #f2f2f2;
444             # padding: 20px;
445             # }
446             # .form input[type=submit]:hover {
447             # background-color: #45a049;
448             # }
449             # .form input[type=submit] {
450             # width: 100%;
451             # background-color: #4CAF50;
452             # color: white;
453             # padding: 14px 20px;
454             # margin: 8px 0;
455             # border: none;
456             # border-radius: 4px;
457             # cursor: pointer;
458             # }
459             # .form input, select, textarea {
460             # width: 100%;
461             # padding: 12px 20px;
462             # margin: 8px 0;
463             # display: inline-block;
464             # border: 1px solid #ccc;
465             # border-radius: 4px;
466             # box-sizing: border-box;
467             # }
468             # .form-required {
469             # color: red;
470             # }
471              
472             =head1 DEPENDENCIES
473              
474             L<Class::Utils>,
475             L<Data::HTML::Form>,
476             L<Data::HTML::Button>,
477             L<Error::Pure>,
478             L<List::Util>,
479             L<Scalar::Util>,
480             L<Tags::HTML>,
481             L<Tags::HTML::Form::Input>,
482             L<Tags::HTML::Form::Select>.
483              
484             =head1 REPOSITORY
485              
486             L<https://github.com/michal-josef-spacek/Tags-HTML-Form>
487              
488             =head1 AUTHOR
489              
490             Michal Josef Špaček L<mailto:skim@cpan.org>
491              
492             L<http://skim.cz>
493              
494             =head1 LICENSE AND COPYRIGHT
495              
496             © 2022 Michal Josef Špaček
497              
498             BSD 2-Clause License
499              
500             =head1 VERSION
501              
502             0.06
503              
504             =cut