1use strict;
2
3package HTML::FormFu::Role::Element::Input;
4$HTML::FormFu::Role::Element::Input::VERSION = '2.07';
5# ABSTRACT: Role for input fields
6
7use Moose::Role;
8
9with 'HTML::FormFu::Role::Element::Field',
10    'HTML::FormFu::Role::Element::FieldMethods' =>
11    { -excludes => 'nested_name' },
12    'HTML::FormFu::Role::Element::Coercible';
13
14use HTML::FormFu::Util qw( literal xml_escape );
15use Clone ();
16use List::Util 1.33 qw( none );
17use Scalar::Util qw( reftype );
18use Carp qw( croak );
19
20use HTML::FormFu::Attribute qw(
21    mk_attr_accessors
22    mk_attr_bool_accessors
23);
24use HTML::FormFu::Constants qw( $EMPTY_STR );
25use HTML::FormFu::Util qw( process_attrs xml_escape );
26
27has field_type => ( is => 'rw', );
28
29has datalist_id => ( is => 'rw' );
30
31has _datalist_options => (
32    is      => 'rw',
33    default => sub { [] },
34    lazy    => 1,
35    isa     => 'ArrayRef',
36);
37
38__PACKAGE__->mk_attr_accessors( qw(
39        alt         autocomplete
40        checked     maxlength
41        pattern     placeholder
42        size
43) );
44
45__PACKAGE__->mk_attr_bool_accessors( qw(
46        autofocus
47        multiple
48        required
49) );
50
51my @ALLOWED_OPTION_KEYS = qw(
52    value
53    value_xml
54    value_loc
55    label
56    label_xml
57    label_loc
58);
59
60sub datalist_options {
61    my ( $self, $arg ) = @_;
62    my ( @options, @new );
63
64    return $self->_datalist_options if @_ == 1;
65
66    croak "datalist_options argument must be a single array-ref" if @_ > 2;
67
68    if ( defined $arg ) {
69        croak "datalist_options argument must be an array-ref"
70            if reftype($arg) ne 'ARRAY';
71
72        @options = @$arg;
73
74        for my $item (@options) {
75            push @new, $self->_parse_option($item);
76        }
77    }
78
79    $self->_datalist_options( \@new );
80
81    return $self;
82}
83
84sub _parse_option {
85    my ( $self, $item ) = @_;
86
87    if ( reftype($item) eq 'HASH' ) {
88        return $self->_parse_option_hashref($item);
89    }
90    elsif ( reftype($item) eq 'ARRAY' ) {
91        return {
92            value => $item->[0],
93            label => $item->[1],
94        };
95    }
96    else {
97        croak "each datalist_options argument must be a hash-ref or array-ref";
98    }
99}
100
101sub _parse_option_hashref {
102    my ( $self, $item ) = @_;
103
104    # sanity check options
105    my @keys = keys %$item;
106
107    for my $key (@keys) {
108        croak "unknown option argument: '$key'"
109            if none { $key eq $_ } @ALLOWED_OPTION_KEYS;
110    }
111
112    if ( defined $item->{label_xml} ) {
113        $item->{label} = literal( $item->{label_xml} );
114    }
115    elsif ( defined $item->{label_loc} ) {
116        $item->{label} = $self->form->localize( $item->{label_loc} );
117    }
118
119    if ( defined $item->{value_xml} ) {
120        $item->{value} = literal( $item->{value_xml} );
121    }
122    elsif ( defined $item->{value_loc} ) {
123        $item->{value} = $self->form->localize( $item->{value_loc} );
124    }
125
126    if ( !defined $item->{value} ) {
127        $item->{value} = '';
128    }
129
130    return $item;
131}
132
133sub datalist_values {
134    my ( $self, $arg ) = @_;
135
136    croak "datalist_values argument must be a single array-ref of values"
137        if @_ > 2;
138
139    my @values;
140
141    if ( defined $arg ) {
142        croak "datalist_values argument must be an array-ref"
143            if reftype($arg) ne 'ARRAY';
144
145        @values = @$arg;
146    }
147
148    my @new = map { { value => $_, label => ucfirst $_, } } @values;
149
150    $self->_datalist_options( \@new );
151
152    return $self;
153}
154
155around prepare_id => sub {
156    my ( $orig, $self, $render ) = @_;
157
158    $self->$orig($render);
159
160    return if !@{ $self->_datalist_options };
161
162    if ( defined $render->{datalist_id} ) {
163        $render->{attributes}{list} = $render->{datalist_id};
164    }
165    elsif ( defined $self->auto_datalist_id
166        && length $self->auto_datalist_id )
167    {
168        my $form_name
169            = defined $self->form->id
170            ? $self->form->id
171            : $EMPTY_STR;
172
173        my $field_name
174            = defined $render->{nested_name}
175            ? $render->{nested_name}
176            : $EMPTY_STR;
177
178        my %string = (
179            f => $form_name,
180            n => $field_name,
181        );
182
183        my $id = $self->auto_datalist_id;
184        $id =~ s/%([fn])/$string{$1}/g;
185
186        if ( defined( my $count = $self->repeatable_count ) ) {
187            $id =~ s/%r/$count/g;
188        }
189
190        $render->{attributes}{list} = $id;
191    }
192    else {
193        croak
194            "either 'datalist_id' or 'auto_datalist_id' must be set when using a datalist";
195    }
196
197    return;
198};
199
200around render_data_non_recursive => sub {
201    my ( $orig, $self, $args ) = @_;
202
203    my $render = $self->$orig(
204        {   field_type  => $self->field_type,
205            placeholder => $self->placeholder,
206            $args ? %$args : (),
207        } );
208
209    if ( @{ $self->_datalist_options } ) {
210        $render->{datalist_options} = Clone::clone( $self->_datalist_options );
211    }
212
213    $self->_quote_options( $render->{datalist_options} );
214
215    return $render;
216};
217
218sub _quote_options {
219    my ( $self, $options ) = @_;
220
221    foreach my $opt (@$options) {
222        $opt->{label} = xml_escape( $opt->{label} );
223        $opt->{value} = xml_escape( $opt->{value} );
224    }
225}
226
227sub _string_field {
228    my ( $self, $render ) = @_;
229
230    my $html = "";
231
232    if ( $render->{datalist_options} ) {
233        $html .= sprintf qq{<datalist id="%s">\n}, $render->{attributes}{list};
234        for my $option ( @{ $render->{datalist_options} } ) {
235            $html .= sprintf qq{<option value="%s">%s</option>\n},
236                $option->{value},
237                $option->{label};
238        }
239        $html .= sprintf qq{</datalist>\n};
240    }
241
242    $html .= "<input";
243
244    if ( defined $render->{nested_name} ) {
245        $html .= sprintf qq{ name="%s"}, $render->{nested_name};
246    }
247
248    $html .= sprintf qq{ type="%s"}, $render->{field_type};
249
250    if ( defined $render->{value} ) {
251        $html .= sprintf qq{ value="%s"}, $render->{value};
252    }
253
254    $html .= sprintf "%s />", process_attrs( $render->{attributes} );
255
256    return $html;
257}
258
259around clone => sub {
260    my ( $orig, $self ) = @_;
261
262    my $clone = $self->$orig(@_);
263
264    $clone->_datalist_options( Clone::clone( $self->_datalist_options ) );
265
266    return $clone;
267};
268
2691;
270
271__END__
272
273=pod
274
275=encoding UTF-8
276
277=head1 NAME
278
279HTML::FormFu::Role::Element::Input - Role for input fields
280
281=head1 VERSION
282
283version 2.07
284
285=head1 DESCRIPTION
286
287Base-class for L<HTML::FormFu::Element::Button>,
288L<HTML::FormFu::Element::Checkbox>,
289L<HTML::FormFu::Element::File>,
290L<HTML::FormFu::Element::Hidden>,
291L<HTML::FormFu::Element::Password>,
292L<HTML::FormFu::Element::Radio>,
293L<HTML::FormFu::Element::Text>.
294
295=head1 METHODS
296
297=head2 datalist_options
298
299Arguments: none
300
301Arguments: \@options
302
303Use either L</datalist_options> or L</datalist_values> to generate a
304HTML5-compatible C<datalist> group of C<option> tags. This will be associated
305with the C<input> element via a C<list> attribute on the C<input> tag.
306
307The C<datalist> ID attribute B<must> be set using either L</datalist_id>
308or L</auto_datalist_id>.
309
310    ---
311    elements:
312      - type: Text
313        name: foo
314        options:
315          - [ 01, January ]
316          - [ 02, February ]
317          - [ 03, March ]
318          - [ 04, April ]
319
320The syntax is similar to L<HTML::FormFu::Role::Element::Group/options>,
321except hash-ref items only accept C<value> and C<label> keys (and their variants).
322
323If passed no arguments, it returns an arrayref of the currently set datalist options.
324
325Its arguments must be an array-ref of items. Each item may be an array ref
326of the form C<[ $value, $label ]> or a hash-ref of the form
327C<< { value => $value, label => $label } >>.
328
329When using the hash-ref construct, the C<label_xml> and C<label_loc>
330variants of C<label> are supported, as are the C<value_xml> and C<value_loc>
331variants of C<value>.
332
333=head2 datalist_values
334
335Arguments: \@values
336
337    ---
338    elements:
339      - type: Radiogroup
340        name: foo
341        values:
342          - jan
343          - feb
344          - mar
345          - apr
346
347A more concise alternative to L</datalist_options>.
348
349Its arguments must be an array-ref of values. The labels used are the
350result of C<ucfirst($value)>.
351
352=head2 datalist_id
353
354Arguments: [$string]
355
356Sets the C<datalist> ID attribute, and automatically sets this C<input> element's
357C<list> ID to the same.
358
359Either L</datalist_id> or L</auto_datalist_id> is required,
360if either L</datalist_options> or L</datalist_values> are set.
361
362=head2 auto_datalist_id
363
364See L<HTML::FormFu/auto_datalist_id> for details.
365
366=head1 ATTRIBUTE ACCESSORS
367
368Get / set input attributes directly with these methods.
369
370Arguments: [$string]
371
372Return Value: $string
373
374=head2 alt
375
376=head2 autocomplete
377
378=head2 checked
379
380=head2 maxlength
381
382=head2 pattern
383
384=head2 placeholder
385
386=head2 size
387
388=head1 BOOLEAN ATTRIBUTE ACCESSORS
389
390Arguments: [$bool]
391
392Return Value: $self
393Return Value: $string
394Return Value: undef
395
396Get / set boolean XHTML attributes such as C<required="required">.
397
398If given any true argument, the attribute value will be set equal to the attribute
399key name. E.g. C<< $element->required(1) >> will set the attribute C<< required="required" >>.
400
401If given a false argument, the attribute key will be deleted.
402
403When used as a setter, the return value is C<< $self >> to allow chaining.
404
405=head2 autofocus
406
407=head2 multiple
408
409=head2 required
410
411=head1 SEE ALSO
412
413Is a sub-class of, and inherits methods from
414L<HTML::FormFu::Role::Element::Field>, L<HTML::FormFu::Element>
415
416L<HTML::FormFu>
417
418=head1 AUTHOR
419
420Carl Franks, C<cfranks@cpan.org>
421
422=head1 LICENSE
423
424This library is free software, you can redistribute it and/or modify it under
425the same terms as Perl itself.
426
427=head1 AUTHOR
428
429Carl Franks <cpan@fireartist.com>
430
431=head1 COPYRIGHT AND LICENSE
432
433This software is copyright (c) 2018 by Carl Franks.
434
435This is free software; you can redistribute it and/or modify it under
436the same terms as the Perl 5 programming language system itself.
437
438=cut
439