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