File Coverage

blib/lib/HTML/Widget/Element/Checkbox.pm
Criterion Covered Total %
statement 36 36 100.0
branch 10 12 83.3
condition 17 19 89.4
subroutine 6 6 100.0
pod 2 2 100.0
total 71 75 94.6


line stmt bran cond sub pod time code
1             package HTML::Widget::Element::Checkbox;
2              
3 88     88   78686 use warnings;
  88         222  
  88         2915  
4 88     88   533 use strict;
  88         178  
  88         3077  
5 88     88   582 use base 'HTML::Widget::Element';
  88         178  
  88         8409  
6 88     88   501 use NEXT;
  88         326  
  88         683  
7              
8             __PACKAGE__->mk_accessors(qw/checked comment label value retain_default/);
9              
10             =head1 NAME
11              
12             HTML::Widget::Element::Checkbox - Checkbox Element
13              
14             =head1 SYNOPSIS
15              
16             my $e = $widget->element( 'Checkbox', 'foo' );
17             $e->comment('(Required)');
18             $e->label('Foo');
19             $e->checked('checked');
20             $e->value('bar');
21              
22             =head1 DESCRIPTION
23              
24             Checkbox Element.
25              
26             =head1 METHODS
27              
28             =head2 retain_default
29              
30             If true, overrides the default behaviour, so that after a field is missing
31             from the form submission, the xml output will contain the default value,
32             rather than be empty.
33              
34             =head2 new
35              
36             =cut
37              
38             sub new {
39 9     9 1 67 shift->NEXT::new(@_)->value(1);
40             }
41              
42             =head2 containerize
43              
44             =cut
45              
46             sub containerize {
47 18     18 1 37 my ( $self, $w, $value, $errors, $args ) = @_;
48              
49 18 50       51 $value = ref $value eq 'ARRAY' ? shift @$value : $value;
50              
51 18         70 my $name = $self->name;
52              
53             # Search for multiple checkboxes with the same name
54 18         107 my $multi = 0;
55 18         75 my @elements = $w->find_elements( name => $name );
56              
57 18         196 for my $element (@elements) {
58 34 100       140 next if $element eq $self;
59 16 50       97 if ( $element->isa('HTML::Widget::Element::Checkbox') ) {
60 16         36 $multi++;
61             }
62             }
63              
64             # Generate unique id
65 18 100       74 if ($multi) {
66 16   100     73 $w->{_stash} ||= {};
67 16   100     88 $w->{_stash}->{checkbox} ||= {};
68 16         44 my $num = ++$w->{_stash}->{checkbox}->{$name};
69 16         111 my $id = $self->id( $w, "$name\_$num" );
70 16   66     74 $self->attributes->{id} ||= $id;
71             }
72              
73 18 100 100     86 my $checked
74             = ( defined $value && $value eq $self->value ) ? 'checked' : undef;
75              
76 18 100 100     136 if ( !defined $value
      66        
      100        
77             && ( $self->retain_default || !$args->{submitted} )
78             && $self->checked )
79             {
80 6         129 $checked = 'checked';
81             }
82 18         155 $value = $self->value;
83              
84 18         135 my $l = $self->mk_label( $w, $self->label, $self->comment, $errors );
85 18         149 my $i = $self->mk_input( $w,
86             { checked => $checked, type => 'checkbox', value => $value }, $errors );
87 18         101 my $e = $self->mk_error( $w, $errors );
88              
89 18         120 return $self->container( { element => $i, error => $e, label => $l } );
90             }
91              
92             =head1 SEE ALSO
93              
94             L
95              
96             =head1 AUTHOR
97              
98             Sebastian Riedel, C
99              
100             =head1 LICENSE
101              
102             This library is free software, you can redistribute it and/or modify it under
103             the same terms as Perl itself.
104              
105             =cut
106              
107             1;