File Coverage

blib/lib/HTML/Widget/Element/RadioGroup.pm
Criterion Covered Total %
statement 77 77 100.0
branch 23 28 82.1
condition 6 9 66.6
subroutine 7 7 100.0
pod 4 4 100.0
total 117 125 93.6


line stmt bran cond sub pod time code
1             package HTML::Widget::Element::RadioGroup;
2              
3 88     88   96584 use warnings;
  88         193  
  88         3404  
4 88     88   484 use strict;
  88         175  
  88         4123  
5 88     88   512 use base 'HTML::Widget::Element';
  88         185  
  88         100206  
6              
7             *value = \&checked;
8              
9             __PACKAGE__->mk_accessors(
10             qw/
11             comment label values labels comments checked _current_subelement
12             constrain_values legend retain_default/
13             );
14              
15             =head1 NAME
16              
17             HTML::Widget::Element::RadioGroup - Radio Element grouping
18              
19             =head1 SYNOPSIS
20              
21             my $e = $widget->element( 'RadioGroup', 'foo' );
22             $e->comment('(Required)');
23             $e->label('Foo'); # label for the whole thing
24             $e->values([qw/foo bar gorch/]);
25             $e->labels([qw/Fu Bur Garch/]); # defaults to ucfirst of values
26             $e->comments([qw/funky/]); # defaults to empty
27             $e->value("foo"); # the currently selected value
28             $e->constrain_values(1);
29              
30             =head1 DESCRIPTION
31              
32             RadioGroup Element.
33              
34             As of version 1.09, an L is no
35             longer automatically added to RadioGroup elements. Use L
36             to provide this functionality.
37              
38             =head1 METHODS
39              
40             =head2 comment
41              
42             Add a comment to this Element.
43              
44             =head2 label
45              
46             This label will be placed next to your Element.
47              
48             =head2 legend
49              
50             Because the RadioGroup is placed in a C
tag, you can also set a
51             value. Note, however, that if you want the RadioGroup to be styled
52             the same as other elements, the L setting is recommended.
53              
54             =head2 values
55              
56             List of form values for radio checks.
57             Will also be used as labels if not otherwise specified via L.
58              
59             =head2 checked
60              
61             =head2 value
62              
63             Set which radio element will be pre-set to "checked".
64              
65             L is provided as an alias for L.
66              
67             =head2 labels
68              
69             The labels for corresponding L.
70              
71             =head2 constrain_values
72              
73             If true, an L will
74             automatically be added to the widget, using the values from L.
75              
76             =head2 retain_default
77              
78             If true, overrides the default behaviour, so that after a field is missing
79             from the form submission, the xml output will contain the default value,
80             rather than be empty.
81              
82             =head2 new
83              
84             =cut
85              
86             sub new {
87 7     7 1 21 my ( $class, $opts ) = @_;
88              
89 7         63 my $self = $class->NEXT::new($opts);
90              
91 7         666 my $values = $opts->{values};
92              
93 7         56 $self->values($values);
94              
95 7         69 $self;
96             }
97              
98             =head2 prepare
99              
100             =cut
101              
102             sub prepare {
103 15     15 1 43 my ( $self, $w, $value ) = @_;
104              
105 15 100       68 if ( $self->constrain_values ) {
106 2         23 my $name = $self->name;
107              
108 2         14 my %seen;
109 2         3 my @uniq = grep { !$seen{$_}++ } @{ $self->values };
  5         32  
  2         6  
110              
111 2 50       32 $w->constraint( 'In', $name )->in(@uniq)
112             if @uniq;
113             }
114              
115 15         225 return;
116             }
117              
118             =head2 containerize
119              
120             =cut
121              
122             sub containerize {
123 15     15 1 37 my ( $self, $w, $value, $errors, $args ) = @_;
124              
125 15 100 100     157 $value = $self->value
      66        
126             if ( not defined $value )
127             and $self->retain_default || not $args->{submitted};
128              
129 15 100       287 $value = '' if not defined $value;
130              
131 15         64 my $name = $self->name;
132 15 50       93 my @values = @{ $self->values || [] };
  15         67  
133 15 50       145 my @labels = @{ $self->labels || [] };
  15         78  
134 15 50       367 @labels = map {ucfirst} @values unless @labels;
  37         130  
135 15 50       31 my @comments = @{ $self->comments || [] };
  15         68  
136              
137 15         218 my $i;
138 37         134 my @radios = map {
139 15         39 $self->_current_subelement( ++$i ); # yucky hack
140              
141 37 100       956 my $radio = $self->mk_input(
142             $w,
143             { type => 'radio',
144             ( $_ eq $value ? ( checked => "checked" ) : () ),
145             value => $_,
146             } );
147              
148 37         166 $radio->attr( class => "radio" );
149              
150 37         733 my $label = $self->mk_label( $w, shift @labels, shift @comments );
151 37         141 $label->unshift_content($radio);
152              
153 37         675 $label;
154             } @values;
155              
156 15         66 $self->_current_subelement(undef);
157              
158 15         131 my $fieldset = HTML::Element->new('fieldset');
159 15         309 $fieldset->attr( class => 'radiogroup_fieldset' );
160              
161 15   33     213 my $outer_id = $self->attributes->{id} || $self->id($w);
162              
163 15 100       74 if ( defined $self->legend ) {
164 1         11 my $legend = HTML::Element->new('legend');
165 1         22 $legend->attr( class => 'radiogroup_legend' );
166 1         14 $legend->push_content( $self->legend );
167 1         21 $fieldset->push_content($legend);
168             }
169              
170             # don't pass commment to mk_label, we'll handle it ourselves
171 15         420 my $l = $self->mk_label( $w, $self->label, undef, $errors );
172 15 100       196 if ($l) {
173 3         90 $l->tag('span');
174 3         42 $l->attr( for => undef );
175 3         118 $l->attr( class => 'radiogroup_label' );
176             }
177              
178 15 100       332 if ( defined $self->comment ) {
179 2         24 my $c = HTML::Element->new(
180             'span',
181             id => "$outer_id\_comment",
182             class => 'label_comments'
183             );
184 2         81 $c->push_content( $self->comment );
185 2         246 $fieldset->push_content($c);
186             }
187              
188 15         195 my $element = HTML::Element->new('span');
189 15         331 $element->attr( class => 'radiogroup' );
190 15         199 $element->push_content(@radios);
191 15         443 $fieldset->push_content($element);
192              
193 15 100       290 if ($errors) {
194 2         5 my $save = $fieldset;
195 2         9 $fieldset = HTML::Element->new('span');
196 2         42 $fieldset->attr( class => 'labels_with_errors' );
197 2         29 $fieldset->attr( id => $outer_id );
198 2         25 $fieldset->push_content($save);
199             }
200             else {
201 13         48 $fieldset->attr( id => $outer_id );
202             }
203              
204 15         261 return $self->container( {
205             element => $fieldset,
206             error => scalar $self->mk_error( $w, $errors ),
207             label => $l,
208             } );
209             }
210              
211             =head2 id
212              
213             =cut
214              
215             sub id {
216 94     94 1 148 my ( $self, $w ) = @_;
217 94         379 my $id = $self->SUPER::id($w);
218 94         1100 my $subelem = $self->_current_subelement;
219              
220 94 100       955 return $subelem
221             ? "${id}_$subelem"
222             : $id;
223             }
224              
225             =head1 CSS
226              
227             =head2 Horizontal Alignment
228              
229             To horizontally align the radio buttons with the label, use the following
230             CSS.
231              
232             .radiogroup > label {
233             display: inline;
234             }
235              
236             =head2 Changes in version 1.10
237              
238             A RadioGroup is now rendered using a C
tag, instead of a C
239             tag. This is because the individual radio buttons also use labels, and the
240             W3C xhtml specification forbids nested C
241              
242             To ensure RadioGroup elements are styled similar to other elements, you must
243             change any CSS C
244             This means changing any C
245             C. If you're using the C
246             example file, testing with firefox shows you'll also need to add
247             C to that definition to get the label to line up with other
248             elements.
249              
250             If you find the RadioGroup C
picking up styles intended only for
251             other fieldsets, you can either override those styles with your
252             C definition, or you can change your
253             C
definition to C<.widget_fieldset{ ... }> to specifically
254             target any Fieldset elements other than the RadioGroup's.
255              
256             Previously, if there were any errors, the L
257             classname C. Now, if there's errors, the RadioGroup
258             C
tag is wrapped in a C tag which is given the classname
259             C. To ensure that any C styles are
260             properly displayed around RadioGroups, you must add C to
261             your C<.labels_with_errros{ ... }> definition.
262              
263             =head1 SEE ALSO
264              
265             L
266              
267             =head1 AUTHOR
268              
269             Jess Robinson
270              
271             Yuval Kogman
272              
273             =head1 LICENSE
274              
275             This library is free software, you can redistribute it and/or modify it under
276             the same terms as Perl itself.
277              
278             =cut
279              
280             1;