1use strict;
2
3package HTML::FormFu::Role::CreateChildren;
4# ABSTRACT: CreateChildren role
5$HTML::FormFu::Role::CreateChildren::VERSION = '2.07';
6use Moose::Role;
7
8use HTML::FormFu::Util qw( _merge_hashes require_class );
9use Carp qw( croak );
10use Clone ();
11use List::Util 1.45 qw( uniq );
12use Scalar::Util qw( weaken );
13
14sub element {
15    my ( $self, $arg ) = @_;
16    my @return;
17
18    if ( ref $arg eq 'ARRAY' ) {
19        push @return, map { $self->_single_element($_) } @$arg;
20    }
21    else {
22        push @return, $self->_single_element($arg);
23    }
24
25    return @return == 1 ? $return[0] : @return;
26}
27
28sub deflator {
29    my ( $self, $arg ) = @_;
30    my @return;
31
32    if ( ref $arg eq 'ARRAY' ) {
33        push @return, map { $self->_single_deflator($_) } @$arg;
34    }
35    else {
36        push @return, $self->_single_deflator($arg);
37    }
38
39    return @return == 1 ? $return[0] : @return;
40}
41
42sub filter {
43    my ( $self, $arg ) = @_;
44    my @return;
45
46    if ( ref $arg eq 'ARRAY' ) {
47        push @return, map { $self->_single_filter($_) } @$arg;
48    }
49    else {
50        push @return, $self->_single_filter($arg);
51    }
52
53    return @return == 1 ? $return[0] : @return;
54}
55
56sub constraint {
57    my ( $self, $arg ) = @_;
58    my @return;
59
60    if ( ref $arg eq 'ARRAY' ) {
61        push @return, map { $self->_single_constraint($_) } @$arg;
62    }
63    else {
64        push @return, $self->_single_constraint($arg);
65    }
66
67    return @return == 1 ? $return[0] : @return;
68}
69
70sub inflator {
71    my ( $self, $arg ) = @_;
72    my @return;
73
74    if ( ref $arg eq 'ARRAY' ) {
75        push @return, map { $self->_single_inflator($_) } @$arg;
76    }
77    else {
78        push @return, $self->_single_inflator($arg);
79    }
80
81    return @return == 1 ? $return[0] : @return;
82}
83
84sub validator {
85    my ( $self, $arg ) = @_;
86    my @return;
87
88    if ( ref $arg eq 'ARRAY' ) {
89        push @return, map { $self->_single_validator($_) } @$arg;
90    }
91    else {
92        push @return, $self->_single_validator($arg);
93    }
94
95    return @return == 1 ? $return[0] : @return;
96}
97
98sub transformer {
99    my ( $self, $arg ) = @_;
100    my @return;
101
102    if ( ref $arg eq 'ARRAY' ) {
103        push @return, map { $self->_single_transformer($_) } @$arg;
104    }
105    else {
106        push @return, $self->_single_transformer($arg);
107    }
108
109    return @return == 1 ? $return[0] : @return;
110}
111
112sub plugin {
113    my ( $self, $arg ) = @_;
114    my @return;
115
116    if ( ref $arg eq 'ARRAY' ) {
117        push @return, map { $self->_single_plugin($_) } @$arg;
118    }
119    else {
120        push @return, $self->_single_plugin($arg);
121    }
122
123    return @return == 1 ? $return[0] : @return;
124}
125
126sub _require_element {
127    my ( $self, $arg ) = @_;
128
129    $arg->{type} = 'Text' if !exists $arg->{type};
130
131    my $type  = delete $arg->{type};
132    my $class = $type;
133
134    if ( not $class =~ s/^\+// ) {
135        $class = "HTML::FormFu::Element::$class";
136    }
137
138    $type =~ s/^\+//;
139
140    require_class($class);
141
142    my $element = $class->new(
143        {   type   => $type,
144            parent => $self,
145        } );
146
147    my $default_args = $self->default_args;
148
149    if (%$default_args) {
150        if ( $element->can('default_args') ) {
151            $element->default_args( Clone::clone($default_args) );
152        }
153
154        $default_args = $element->_match_default_args(
155            Clone::clone( $default_args->{elements} ) );
156
157        if (%$default_args) {
158            $arg = _merge_hashes( $arg, $default_args );
159        }
160    }
161
162    $element->populate($arg);
163
164    $element->setup;
165
166    return $element;
167}
168
169sub _single_element {
170    my ( $self, $arg ) = @_;
171
172    if ( !ref $arg ) {
173        $arg = { type => $arg };
174    }
175    elsif ( ref $arg eq 'HASH' ) {
176        $arg = {%$arg};    # shallow clone
177    }
178    else {
179        croak 'invalid args';
180    }
181
182    my $new = $self->_require_element($arg);
183
184    if (   $self->can('auto_fieldset')
185        && $self->auto_fieldset
186        && $new->type ne 'Fieldset' )
187    {
188        my ($target)
189            = reverse @{ $self->get_elements( { type => 'Fieldset' } ) };
190
191        push @{ $target->_elements }, $new;
192
193        $new->{parent} = $target;
194        weaken $new->{parent};
195    }
196    else {
197        push @{ $self->_elements }, $new;
198    }
199
200    return $new;
201}
202
203sub _single_deflator {
204    my ( $self, $arg ) = @_;
205
206    if ( !ref $arg ) {
207        $arg = { type => $arg };
208    }
209    elsif ( ref $arg eq 'HASH' ) {
210        $arg = {%$arg};    # shallow clone
211    }
212    else {
213        croak 'invalid args';
214    }
215
216    my @names = map { ref $_ ? @$_ : $_ }
217        grep {defined} ( delete $arg->{name}, delete $arg->{names} );
218
219    if ( !@names ) {
220        @names = uniq
221            grep {defined}
222            map  { $_->nested_name } @{ $self->get_fields };
223    }
224
225    croak "no field names to add deflator to" if !@names;
226
227    my $type = delete $arg->{type};
228
229    my @return;
230
231    for my $x (@names) {
232        for my $field ( @{ $self->get_fields( { nested_name => $x } ) } ) {
233            my $new = $field->_require_deflator( $type, $arg );
234            push @{ $field->_deflators }, $new;
235            push @return, $new;
236        }
237    }
238
239    return @return;
240}
241
242sub _single_filter {
243    my ( $self, $arg ) = @_;
244
245    if ( !ref $arg ) {
246        $arg = { type => $arg };
247    }
248    elsif ( ref $arg eq 'HASH' ) {
249        $arg = {%$arg};    # shallow clone
250    }
251    else {
252        croak 'invalid args';
253    }
254
255    my @names = map { ref $_ ? @$_ : $_ }
256        grep {defined} ( delete $arg->{name}, delete $arg->{names} );
257
258    if ( !@names ) {
259        @names = uniq
260            grep {defined}
261            map  { $_->nested_name } @{ $self->get_fields };
262    }
263
264    croak "no field names to add filter to" if !@names;
265
266    my $type = delete $arg->{type};
267
268    my @return;
269
270    for my $x (@names) {
271        for my $field ( @{ $self->get_fields( { nested_name => $x } ) } ) {
272            my $new = $field->_require_filter( $type, $arg );
273            push @{ $field->_filters }, $new;
274            push @return, $new;
275        }
276    }
277
278    return @return;
279}
280
281sub _single_constraint {
282    my ( $self, $arg ) = @_;
283
284    if ( !ref $arg ) {
285        $arg = { type => $arg };
286    }
287    elsif ( ref $arg eq 'HASH' ) {
288        $arg = {%$arg};    # shallow clone
289    }
290    else {
291        croak 'invalid args';
292    }
293
294    my @names = map { ref $_ ? @$_ : $_ }
295        grep {defined} ( delete $arg->{name}, delete $arg->{names} );
296
297    if ( !@names ) {
298        @names = uniq
299            grep {defined}
300            map  { $_->nested_name } @{ $self->get_fields };
301    }
302
303    croak "no field names to add constraint to" if !@names;
304
305    my $type = delete $arg->{type};
306
307    my @return;
308
309    for my $x (@names) {
310        for my $field ( @{ $self->get_fields( { nested_name => $x } ) } ) {
311            my $new = $field->_require_constraint( $type, $arg );
312            push @{ $field->_constraints }, $new;
313            push @return, $new;
314        }
315    }
316
317    return @return;
318}
319
320sub _single_inflator {
321    my ( $self, $arg ) = @_;
322
323    if ( !ref $arg ) {
324        $arg = { type => $arg };
325    }
326    elsif ( ref $arg eq 'HASH' ) {
327        $arg = {%$arg};    # shallow clone
328    }
329    else {
330        croak 'invalid args';
331    }
332
333    my @names = map { ref $_ ? @$_ : $_ }
334        grep {defined} ( delete $arg->{name}, delete $arg->{names} );
335
336    if ( !@names ) {
337        @names = uniq
338            grep {defined}
339            map  { $_->nested_name } @{ $self->get_fields };
340    }
341
342    croak "no field names to add inflator to" if !@names;
343
344    my $type = delete $arg->{type};
345
346    my @return;
347
348    for my $x (@names) {
349        for my $field ( @{ $self->get_fields( { nested_name => $x } ) } ) {
350            my $new = $field->_require_inflator( $type, $arg );
351            push @{ $field->_inflators }, $new;
352            push @return, $new;
353        }
354    }
355
356    return @return;
357}
358
359sub _single_validator {
360    my ( $self, $arg ) = @_;
361
362    if ( !ref $arg ) {
363        $arg = { type => $arg };
364    }
365    elsif ( ref $arg eq 'HASH' ) {
366        $arg = {%$arg};    # shallow clone
367    }
368    else {
369        croak 'invalid args';
370    }
371
372    my @names = map { ref $_ ? @$_ : $_ }
373        grep {defined} ( delete $arg->{name}, delete $arg->{names} );
374
375    if ( !@names ) {
376        @names = uniq
377            grep {defined}
378            map  { $_->nested_name } @{ $self->get_fields };
379    }
380
381    croak "no field names to add validator to" if !@names;
382
383    my $type = delete $arg->{type};
384
385    my @return;
386
387    for my $x (@names) {
388        for my $field ( @{ $self->get_fields( { nested_name => $x } ) } ) {
389            my $new = $field->_require_validator( $type, $arg );
390            push @{ $field->_validators }, $new;
391            push @return, $new;
392        }
393    }
394
395    return @return;
396}
397
398sub _single_transformer {
399    my ( $self, $arg ) = @_;
400
401    if ( !ref $arg ) {
402        $arg = { type => $arg };
403    }
404    elsif ( ref $arg eq 'HASH' ) {
405        $arg = {%$arg};    # shallow clone
406    }
407    else {
408        croak 'invalid args';
409    }
410
411    my @names = map { ref $_ ? @$_ : $_ }
412        grep {defined} ( delete $arg->{name}, delete $arg->{names} );
413
414    if ( !@names ) {
415        @names = uniq
416            grep {defined}
417            map  { $_->nested_name } @{ $self->get_fields };
418    }
419
420    croak "no field names to add transformer to" if !@names;
421
422    my $type = delete $arg->{type};
423
424    my @return;
425
426    for my $x (@names) {
427        for my $field ( @{ $self->get_fields( { nested_name => $x } ) } ) {
428            my $new = $field->_require_transformer( $type, $arg );
429            push @{ $field->_transformers }, $new;
430            push @return, $new;
431        }
432    }
433
434    return @return;
435}
436
4371;
438
439__END__
440
441=pod
442
443=encoding UTF-8
444
445=head1 NAME
446
447HTML::FormFu::Role::CreateChildren - CreateChildren role
448
449=head1 VERSION
450
451version 2.07
452
453=head1 AUTHOR
454
455Carl Franks <cpan@fireartist.com>
456
457=head1 COPYRIGHT AND LICENSE
458
459This software is copyright (c) 2018 by Carl Franks.
460
461This is free software; you can redistribute it and/or modify it under
462the same terms as the Perl 5 programming language system itself.
463
464=cut
465