File Coverage

blib/lib/HTML/Widget/Plugin/Multiselect.pm
Criterion Covered Total %
statement 36 36 100.0
branch 14 14 100.0
condition 3 3 100.0
subroutine 9 9 100.0
pod 4 4 100.0
total 66 66 100.0


line stmt bran cond sub pod time code
1 15     15   16352 use strict;
  15         30  
  15         483  
2 15     15   79 use warnings;
  15         27  
  15         767  
3             package HTML::Widget::Plugin::Multiselect;
4             # ABSTRACT: widget for multiple selections from a list
5             $HTML::Widget::Plugin::Multiselect::VERSION = '0.202';
6 15     15   76 use parent 'HTML::Widget::Plugin::Select';
  15         24  
  15         80  
7              
8             #pod =head1 SYNOPSIS
9             #pod
10             #pod $widget_factory->multiselect({
11             #pod id => 'multiopts', # if no name attr given, defaults to id value
12             #pod size => 3,
13             #pod values => [ 'value_1', 'value_3' ],
14             #pod options => [
15             #pod [ value_1 => 'Display Name 1' ],
16             #pod [ value_2 => 'Display Name 2' ],
17             #pod [ value_3 => 'Display Name 3' ],
18             #pod ],
19             #pod });
20             #pod
21             #pod =head1 DESCRIPTION
22             #pod
23             #pod This plugin provides a select-from-list widget that allows the selection of
24             #pod multiple elements.
25             #pod
26             #pod =cut
27              
28 15     15   694 use HTML::Element;
  15         33  
  15         70  
29              
30             #pod =head1 METHODS
31             #pod
32             #pod =head2 C< provided_widgets >
33             #pod
34             #pod This plugin provides the following widgets: multiselect
35             #pod
36             #pod =cut
37              
38 16     16 1 55 sub provided_widgets { qw(multiselect) }
39              
40             #pod =head2 C< multiselect >
41             #pod
42             #pod This method returns a multiple-selection-from-list widget. Yup.
43             #pod
44             #pod In addition to the generic L attributes and the
45             #pod L attributes, the following are valid arguments:
46             #pod
47             #pod =over
48             #pod
49             #pod =item size
50             #pod
51             #pod This is the number of elements that should be visible in the widget.
52             #pod
53             #pod =back
54             #pod
55             #pod =cut
56              
57 16     16   63 sub _attribute_args { qw(size) }
58              
59             sub multiselect {
60 4     4 1 9 my ($self, $factory, $arg) = @_;
61              
62 4 100       19 $arg->{attr}{name} = $arg->{attr}{id} if not defined $arg->{attr}{name};
63 4         11 $arg->{attr}{multiple} = 'multiple';
64              
65 4 100       10 if ($arg->{values}) {
66 1         3 $arg->{value} = delete $arg->{values};
67             }
68              
69 4         20 $self->build($factory, $arg);
70             }
71              
72             #pod =head2 C< make_option>
73             #pod
74             #pod This method, subclassed from the standard select widget, expects that C<$value>
75             #pod will be an array of selected values.
76             #pod
77             #pod =cut
78              
79             sub make_option {
80 12     12 1 17 my ($self, $factory, $value, $name, $arg) = @_;
81              
82 12         36 my $option = HTML::Element->new('option', value => $value);
83 12         297 $option->push_content($name);
84 16         45 $option->attr(selected => 'selected')
85 12 100 100     167 if $arg->{value} and grep { $_ eq $value } @{ $arg->{value} };
  8         12  
86              
87 12         68 return $option;
88             }
89              
90             #pod =head2 C< validate_value >
91             #pod
92             #pod This method checks whether the given value option is valid. It throws an
93             #pod exception if the given values are not all in the list of options.
94             #pod
95             #pod =cut
96              
97             sub validate_value {
98 4     4 1 10 my ($class, $values, $options) = @_;
99              
100 4 100       12 $values = [ $values ] unless ref $values;
101 4 100       11 return unless grep { defined } @$values;
  7         21  
102              
103 3         8 for my $value (@$values) {
104 6 100       15 my $matches = grep { $value eq $_ } map { ref $_ ? $_->[0] : $_ } @$options;
  24         35  
  24         44  
105 6 100       265 Carp::croak "provided value '$value' not in given options" unless $matches;
106             }
107             }
108              
109             1;
110              
111             __END__