File Coverage

blib/lib/HTML/FormFu/Element/ComboBox.pm
Criterion Covered Total %
statement 118 124 95.1
branch 25 32 78.1
condition 9 12 75.0
subroutine 23 23 100.0
pod 1 8 12.5
total 176 199 88.4


line stmt bran cond sub pod time code
1 5     5   890 use strict;
  5         14  
  5         341  
2              
3             package HTML::FormFu::Element::ComboBox;
4             $HTML::FormFu::Element::ComboBox::VERSION = '2.07';
5             # ABSTRACT: Select / Text hybrid
6              
7 5     5   32 use Moose;
  5         11  
  5         38  
8 5     5   35783 use MooseX::Attribute::Chained;
  5         16  
  5         248  
9             extends 'HTML::FormFu::Element::Multi';
10              
11             with 'HTML::FormFu::Role::Element::ProcessOptionsFromModel';
12              
13 5     5   32 use HTML::FormFu::Util qw( _filter_components _parse_args );
  5         12  
  5         385  
14 5     5   37 use List::Util 1.33 qw( any );
  5         132  
  5         300  
15 5     5   34 use Moose::Util qw( apply_all_roles );
  5         10  
  5         39  
16              
17             our @DEFER_TO_SELECT = qw(
18             empty_first
19             empty_first_label
20             values
21             value_range
22             );
23              
24             for my $name (@DEFER_TO_SELECT) {
25             has $name => ( is => 'rw', traits => ['Chained'] );
26             }
27              
28             has select => ( is => 'rw', traits => ['Chained'], default => sub { {} } );
29             has text => ( is => 'rw', traits => ['Chained'], default => sub { {} } );
30              
31             *default = \&value;
32              
33             ## build get_Xs methods
34             for my $method ( qw(
35             deflator filter
36             constraint inflator
37             validator transformer
38             ) )
39             {
40             my $sub = sub {
41 52     52   103 my $self = shift;
        52      
42 52         136 my %args = _parse_args(@_);
43 52         145 my $get_method = "get_${method}s";
44              
45 52         122 my $accessor = "_${method}s";
46 52         78 my @x = @{ $self->$accessor };
  52         1727  
47 52         99 push @x, map { @{ $_->$get_method(@_) } } @{ $self->_elements };
  104         144  
  104         537  
  52         1466  
48              
49 52         130 return _filter_components( \%args, \@x );
50             };
51              
52             my $name = __PACKAGE__ . "::get_${method}s";
53              
54             ## no critic (ProhibitNoStrict);
55 5     5   2795 no strict 'refs';
  5         11  
  5         6475  
56              
57             *{$name} = $sub;
58             }
59              
60             after BUILD => sub {
61             my ( $self, $args ) = @_;
62              
63             $self->multi_value(1);
64             $self->empty_first(1);
65              
66             return;
67             };
68              
69             sub options {
70 1     1 1 3 my ( $self, @args ) = @_;
71              
72 1 50       4 if (@args) {
73 1 50       4 $self->{options} = @args == 1 ? $args[0] : \@args;
74              
75 1         13 return $self;
76             }
77             else {
78              
79             # we're being called as a getter!
80             # are the child elements made yet?
81              
82 0 0       0 if ( !@{ $self->_elements } ) {
  0         0  
83              
84             # need to build the children, so we can return the select options
85 0         0 $self->_add_elements;
86             }
87              
88 0         0 return $self->_elements->[0]->options;
89             }
90             }
91              
92             sub value {
93 47     47 0 104 my ( $self, $value ) = @_;
94              
95 47 100       126 if ( @_ > 1 ) {
96 2         6 $self->{value} = $value;
97              
98             # if we're already built - i.e. process() has been called,
99             # call default() on our children
100              
101 2 50       5 if ( @{ $self->_elements } ) {
  2         61  
102 2         7 $self->_combobox_defaults;
103              
104 2         59 $self->_elements->[0]->default( $self->select->{default} );
105 2         58 $self->_elements->[1]->default( $self->text->{default} );
106             }
107              
108 2         5 return $self;
109             }
110              
111 45         2021 return $self->{value};
112             }
113              
114             sub _add_elements {
115 15     15   45 my ($self) = @_;
116              
117 15         513 $self->_elements( [] );
118              
119 15         61 $self->_add_select;
120 15         57 $self->_add_text;
121              
122 15         76 $self->_combobox_defaults;
123              
124 15         31 return;
125             }
126              
127             sub _combobox_defaults {
128 17     17   49 my ($self) = @_;
129              
130 17 100       76 if ( defined( my $default = $self->default ) ) {
131              
132 7 100 66     39 if ( !$self->form->submitted || $self->render_processed_value ) {
133 5         9 for my $deflator ( @{ $self->_deflators } ) {
  5         152  
134 0         0 $default = $deflator->process($default);
135             }
136             }
137              
138 7         209 my $select_options = $self->_elements->[0]->options;
139              
140 7 100 66     111 if ( $default ne ''
141 24     24   66 && any { $_->{value} eq $default } @$select_options )
142             {
143 2         65 $self->select->{default} = $default;
144 2         112 $self->text->{default} = undef;
145             }
146             else {
147 5         166 $self->select->{default} = undef;
148 5         145 $self->text->{default} = $default;
149             }
150             }
151              
152 17         58 return;
153             }
154              
155             sub _add_select {
156 15     15   47 my ($self) = @_;
157              
158 15         513 my $select = $self->select;
159              
160 15         49 my $select_name = _build_field_name( $self, 'select' );
161              
162 15         128 my $select_element = $self->element(
163             { type => 'Select',
164             name => $select_name,
165             } );
166              
167 15         98 apply_all_roles( $select_element,
168             'HTML::FormFu::Role::Element::MultiElement' );
169              
170 15         233866 for my $method (@DEFER_TO_SELECT) {
171 60 100       2077 if ( defined( my $value = $self->$method ) ) {
172 27         565 $select_element->$method($value);
173             }
174             }
175              
176 15 100       33 if ( !@{ $select_element->options } ) {
  15         70  
177              
178             # we need to access the hashkey directly,
179             # otherwise we'll have a loop
180 3         10 $select_element->options( $self->{options} );
181             }
182              
183 15 100       89 if ( defined( my $default = $select->{default} ) ) {
184 1         6 $select_element->default($default);
185             }
186              
187 15         46 return;
188             }
189              
190             sub _add_text {
191 15     15   40 my ($self) = @_;
192              
193 15         480 my $text = $self->text;
194              
195 15         63 my $text_name = _build_field_name( $self, 'text' );
196              
197 15         106 my $text_element = $self->element(
198             { type => 'Text',
199             name => $text_name,
200             } );
201              
202 15         96 apply_all_roles( $text_element,
203             'HTML::FormFu::Role::Element::MultiElement' );
204              
205 15 100       232514 if ( defined( my $default = $text->{default} ) ) {
206 4         22 $text_element->default($default);
207             }
208              
209 15         47 return;
210             }
211              
212             sub get_select_field_nested_name {
213 11     11 0 27 my ($self) = @_;
214              
215 11         44 my $select_name = _build_field_name( $self, 'select' );
216              
217 11         94 return $self->get_element( { name => $select_name } )->nested_name;
218             }
219              
220             sub get_text_field_nested_name {
221 11     11 0 26 my ($self) = @_;
222              
223 11         44 my $text_name = _build_field_name( $self, 'text' );
224              
225 11         55 return $self->get_element( { name => $text_name } )->nested_name;
226             }
227              
228             sub _build_field_name {
229 52     52   122 my ( $self, $type ) = @_;
230              
231 52         1630 my $options = $self->$type;
232 52         89 my $name;
233              
234 52 50       157 if ( defined( my $default_name = $options->{name} ) ) {
235 0         0 $name = $default_name;
236             }
237             else {
238 52         185 $name = sprintf "%s_%s", $self->name, $type;
239             }
240              
241 52         147 return $name;
242             }
243              
244             sub process {
245 15     15 0 41 my ( $self, @args ) = @_;
246              
247 15         100 $self->_process_options_from_model;
248              
249 15         59 $self->_add_elements;
250              
251 15         136 return $self->SUPER::process(@args);
252             }
253              
254             sub process_input {
255 11     11 0 28 my ( $self, $input ) = @_;
256              
257 11         39 my $select_name = $self->get_select_field_nested_name;
258 11         52 my $text_name = $self->get_text_field_nested_name;
259              
260 11         80 my $select_value = $self->get_nested_hash_value( $input, $select_name );
261 11         34 my $text_value = $self->get_nested_hash_value( $input, $text_name );
262              
263 11 100 100     108 if ( defined $text_value && length $text_value ) {
    100 66        
264 4         17 $self->set_nested_hash_value( $input, $self->nested_name, $text_value,
265             );
266             }
267             elsif ( defined $select_value && length $select_value ) {
268 6         27 $self->set_nested_hash_value( $input, $self->nested_name,
269             $select_value, );
270             }
271              
272 11         58 return $self->SUPER::process_input($input);
273             }
274              
275             sub render_data {
276 6     6 0 23 return shift->render_data_non_recursive(@_);
277             }
278              
279             sub render_data_non_recursive {
280 6     6 0 15 my ( $self, $args ) = @_;
281              
282             my $render = $self->SUPER::render_data_non_recursive(
283 6 50       14 { elements => [ map { $_->render_data } @{ $self->_elements } ],
  12         57  
  6         202  
284             $args ? %$args : (),
285             } );
286              
287 6         26 return $render;
288             }
289              
290             __PACKAGE__->meta->make_immutable;
291              
292             1;
293              
294             __END__
295              
296             =pod
297              
298             =encoding UTF-8
299              
300             =head1 NAME
301              
302             HTML::FormFu::Element::ComboBox - Select / Text hybrid
303              
304             =head1 VERSION
305              
306             version 2.07
307              
308             =head1 SYNOPSIS
309              
310             ---
311             elements:
312             - type: ComboBox
313             name: answer
314             label: 'Select yes or no, or write an alternative:'
315             values:
316             - yes
317             - no
318              
319             =head1 DESCRIPTION
320              
321             Creates a L<multi|HTML::FormFu::Element::Multi> element containing a Select
322             field and a Text field.
323              
324             A ComboBox element named C<foo> would result in a Select menu named
325             C<foo_select> and a Text field named C<foo_text>. The names can instead be
326             overridden by the C<name> value in L</select> and L</text>.
327              
328             If a value is submitted for the Text field, this will be used in preference
329             to any submitted value for the Select menu.
330              
331             You can access the submitted value by using the ComboBox's name:
332              
333             my $value = $form->param_value('foo');
334              
335             =head1 METHODS
336              
337             =head2 default
338              
339             If the value matches one of the Select menu's options, that options will be
340             selected. Otherwise, the Text field will use the value as its default.
341              
342             =head2 options
343              
344             See L<HTML::FormFu::Role::Element::Group/options> for details.
345              
346             =head2 values
347              
348             See L<HTML::FormFu::Role::Element::Group/values> for details.
349              
350             =head2 value_range
351              
352             See L<HTML::FormFu::Role::Element::Group/value_range> for details.
353              
354             =head2 empty_first
355              
356             See L<HTML::FormFu::Role::Element::Group/empty_first> for details.
357              
358             =head2 empty_first_label
359              
360             See L<HTML::FormFu::Role::Element::Group/empty_first_label> for details.
361              
362             =head2 select
363              
364             Arguments: \%setting
365              
366             Set values effecting the Select menu. Known keys are:
367              
368             =head3 name
369              
370             Override the auto-generated name of the select menu.
371              
372             =head2 text
373              
374             Arguments: \%setting
375              
376             Set values effecting the Text field. Known keys are:
377              
378             =head3 name
379              
380             Override the auto-generated name of the select menu.
381              
382             =head1 CAVEATS
383              
384             Although this element inherits from L<HTML::FormFu::Element::Block>, its
385             behaviour for the methods
386             L<filterE<sol>filters|HTML::FormFu/filters>,
387             L<constraintE<sol>constraints|HTML::FormFu/constraints>,
388             L<inflatorE<sol>inflators|HTML::FormFu/inflators>,
389             L<validatorE<sol>validators|HTML::FormFu/validators> and
390             L<transformerE<sol>transformers|HTML::FormFu/transformers> is more like that of
391             a L<field element|HTML::FormFu::Role::Element::Field>, meaning all processors are
392             added directly to the date element, not to its child elements.
393              
394             This element's L<get_elements|HTML::FormFu/get_elements> and
395             L<get_all_elements|HTML::FormFu/get_all_elements> are inherited from
396             L<HTML::FormFu::Element::Block>, and so have the same behaviour. However, it
397             overrides the C<get_fields|HTML::FormFu/get_fields> method, such that it
398             returns both itself and its child elements.
399              
400             =head1 SEE ALSO
401              
402             Is a sub-class of, and inherits methods from
403             L<HTML::FormFu::Element::Multi>,
404             L<HTML::FormFu::Element::Block>,
405             L<HTML::FormFu::Element>
406              
407             L<HTML::FormFu>
408              
409             =head1 AUTHOR
410              
411             Carl Franks, C<cfranks@cpan.org>
412              
413             =head1 LICENSE
414              
415             This library is free software, you can redistribute it and/or modify it under
416             the same terms as Perl itself.
417              
418             =head1 AUTHOR
419              
420             Carl Franks <cpan@fireartist.com>
421              
422             =head1 COPYRIGHT AND LICENSE
423              
424             This software is copyright (c) 2018 by Carl Franks.
425              
426             This is free software; you can redistribute it and/or modify it under
427             the same terms as the Perl 5 programming language system itself.
428              
429             =cut