File Coverage

blib/lib/HTML/Shakan/Widgets/Simple.pm
Criterion Covered Total %
statement 90 90 100.0
branch 18 24 75.0
condition 7 8 87.5
subroutine 14 14 100.0
pod 0 8 0.0
total 129 144 89.5


line stmt bran cond sub pod time code
1             package HTML::Shakan::Widgets::Simple;
2 22     22   102 use strict;
  22         34  
  22         633  
3 22     22   101 use warnings;
  22         37  
  22         446  
4 22     22   98 use HTML::Escape;
  22         65  
  22         1025  
5 22     22   20465 use List::MoreUtils qw/zip/;
  22         26802  
  22         29610  
6              
7             sub render {
8 28     28 0 50 my ($self, $form, $field) = @_;
9              
10 28         76 my $type = $field->widget;
11 28 50       205 my $code = $self->can("widget_${type}") or die "unknown widget type: $type";
12 28         84 $code->(
13             $self, $form, $field
14             );
15             }
16              
17             sub _attr {
18 47     47   66 my $attr = shift;
19              
20 47         52 my @ret;
21              
22 47         216 for my $key (sort keys %$attr) {
23 107         538 push @ret, sprintf(q{%s="%s"}, HTML::Escape::escape_html($key), HTML::Escape::escape_html($attr->{$key}));
24             }
25 47         394 join ' ', @ret;
26             }
27              
28              
29             sub widget_input {
30 16     16 0 26 my ($self, $form, $field) = @_;
31              
32 16         56 my $value = $form->fillin_param($field->{name});
33 16 100       49 if (defined $value) {
34 4         41 $field->value($value);
35             }
36              
37 16         58 return 'attr) . " />";
38             }
39              
40             sub widget_textarea {
41 1     1 0 3 my ($self, $form, $field) = @_;
42              
43 1   50     4 my $value = $form->fillin_param($field->{name}) || '';
44 1         3 my $attr = {%{$field->attr}}; # shallow copy
  1         7  
45 1         4 delete $attr->{type}; # textarea tag doesn't need this
46 1         3 return '";
47             }
48              
49             sub widget_select {
50 12     12 0 20 my ($self, $form, $field) = @_;
51              
52 12         21 my $choices = $field->{choices};
53              
54 12         40 my $value = $form->fillin_param($field->{name});
55              
56 12         18 my @t;
57 12         56 push @t, sprintf(q{
58 12         46 for (my $i=0; $i<@$choices; $i+=2) {
59 109         161 my ($a, $b) = ($choices->[$i], $choices->[$i+1]);
60 109 100 100     774 push @t, sprintf(
61             q{},
62             HTML::Escape::escape_html($a),
63             (defined $value && $value eq $a ? ' selected="selected"' : ''),
64             HTML::Escape::escape_html($b));
65             }
66 12         19 push @t, q{};
67 12         118 return join "\n", @t;
68             }
69              
70             sub widget_radio {
71 5     5 0 10 my ($self, $form, $field) = @_;
72              
73 5         11 my $choices = $field->{choices};
74              
75 5         19 my $value = $form->fillin_param($field->{name});
76              
77 5         11 my @t;
78 5         9 push @t, "
    ";
79 5         22 for (my $i=0; $i<@$choices; $i+=2) {
80 15         33 my ($a, $b) = ($choices->[$i], $choices->[$i+1]);
81 15         231 push @t, sprintf(
82             q{
  • },
    83             _attr({
    84 15 100 100     21 %{ $field->attr },
    85             id => sprintf( $field->id_tmpl, $field->{name}, $i / 2 ),
    86             }),
    87             HTML::Escape::escape_html($a),
    88             (defined $value && $value eq $a ? ' checked="checked"' : ''),
    89             HTML::Escape::escape_html($b)
    90             );
    91             }
    92 5         12 push @t, "";
    93 5         34 join "\n", @t;
    94             }
    95              
    96             sub widget_checkbox {
    97 1     1 0 3 my ($self, $form, $field) = @_;
    98              
    99 1         2 my $choices = $field->{choices};
    100              
    101 1         5 my $values = $form->fillin_param($field->{name});
    102 1 50       4 unless (ref $values) {
    103 1 50       4 $values = defined $values ? [$values] : [];
    104             }
    105 1         2 my @t;
    106 1         2 push @t, "
      ";
    107 1         6 for (my $i=0; $i<@$choices; $i+=2) {
    108 3         6 my ($val, $label) = ($choices->[$i], $choices->[$i+1]);
    109 3         4 my $checked = grep /^$val$/, @$values;
    110              
    111 3         25 push @t, sprintf(
    112             '
  • ',
    113             _attr({
    114 3 50       4 %{ $field->attr },
    115             id => sprintf( $field->id_tmpl, $field->{name}, $i / 2 ),
    116             }),
    117             HTML::Escape::escape_html($val),
    118             ($checked ? ' checked="checked"' : ''),
    119             HTML::Escape::escape_html($label),
    120             );
    121             }
    122 1         3 push @t, "";
    123 1         6 join "\n", @t;
    124             }
    125              
    126             sub widget_date {
    127 2     2 0 6 my ($self, $form, $field) = @_;
    128 2 50       9 my $name = $field->{name} or die "missing name";
    129 2 50       8 my $years = $field->{years} or die "missing years";
    130              
    131             my $set = sub {
    132 6     6   11 my ($choices, $suffix) = @_;
    133 6         124 $self->widget_select(
    134             $form,
    135             HTML::Shakan::Field::Choice->new(
    136             name => "${name}_${suffix}",
    137             choices => [zip(@$choices, @$choices)],
    138             )
    139             );
    140 2         11 };
    141              
    142 2         5 my @t;
    143              
    144 2         4 push @t, '';
    145              
    146 2         6 push @t, $set->($years, 'year');
    147 2         26 push @t, $set->([1..12], 'month');
    148 2         27 push @t, $set->([1..31], 'day');
    149              
    150 2         23 push @t, '';
    151              
    152 2         24 join "\n", @t;
    153             }
    154              
    155             sub field_filter {
    156 62     62 0 121 my ($self, $form, $field, $params) = @_;
    157              
    158 62 100       428 if ($field->widget eq 'date') {
    159 4         9 my @c;
    160 4         11 for my $k (qw/year month day/) {
    161 12         50 my $key = $field->name . '_' . $k;
    162 12         42 my $v = $form->request->param($key);
    163 12 100       224 if (defined $v) {
    164 9         21 push @c, $v;
    165             }
    166             }
    167              
    168 4 100       18 if (@c == 3) {
    169 3         30 $params->{$field->name} = join '-', @c; # http-date style
    170             }
    171             }
    172             }
    173              
    174             1;
    175             __END__