1use strict; 2 3package HTML::FormFu::Role::Constraint::Others; 4$HTML::FormFu::Role::Constraint::Others::VERSION = '2.07'; 5# ABSTRACT: Base class for constraints needing others() method 6 7use Moose::Role; 8 9use HTML::FormFu::Util qw( 10 DEBUG_CONSTRAINTS_OTHERS 11 debug 12); 13use Clone (); 14use List::Util 1.33 qw( any none ); 15 16has others => ( is => 'rw', traits => ['Chained'] ); 17has other_siblings => ( is => 'rw', traits => ['Chained'] ); 18has attach_errors_to => ( is => 'rw', traits => ['Chained'] ); 19has attach_errors_to_base => ( is => 'rw', traits => ['Chained'] ); 20has attach_errors_to_others => ( is => 'rw', traits => ['Chained'] ); 21 22sub pre_process { 23 my ($self) = @_; 24 25 if ( $self->other_siblings ) { 26 27 my $field = $self->field; 28 my $block = $field; 29 30 # find the nearest parent that contains any field other than 31 # the one this constraint is attached to 32 while ( defined( my $parent = $block->parent ) ) { 33 $block = $parent; 34 35 last if grep { $_ ne $field } @{ $block->get_fields }; 36 } 37 38 my @names; 39 40 for my $sibling ( @{ $block->get_fields } ) { 41 next if $sibling == $field; 42 43 push @names, $sibling->nested_name; 44 } 45 46 $self->others( [@names] ); 47 } 48} 49 50after repeatable_repeat => sub { 51 my ( $self, $repeatable, $new_block ) = @_; 52 53 my $block_fields = $new_block->get_fields; 54 55 # rename any 'others' fields 56 { 57 my $others = $self->others; 58 if ( !ref $others ) { 59 $others = [$others]; 60 } 61 my @new_others; 62 63 for my $name (@$others) { 64 my $field = $repeatable->get_field_with_original_name( $name, 65 $block_fields ); 66 67 if ( defined $field ) { 68 DEBUG_CONSTRAINTS_OTHERS && debug( 69 sprintf 70 "Repeatable renaming constraint 'other' '%s' to '%s'", 71 $name, $field->nested_name, 72 ); 73 74 push @new_others, $field->nested_name; 75 } 76 else { 77 push @new_others, $name; 78 } 79 } 80 81 $self->others( \@new_others ); 82 } 83 84 # rename any 'attach_errors_to' fields 85 if ( my $others = $self->attach_errors_to ) { 86 my @new_others; 87 88 for my $name (@$others) { 89 my $field = $repeatable->get_field_with_original_name( $name, 90 $block_fields ); 91 92 if ( defined $field ) { 93 DEBUG_CONSTRAINTS_OTHERS && debug( 94 sprintf 95 "Repeatable renaming constraint 'attach_errors_to' '%s' to '%s'", 96 $name, $field->nested_name, 97 ); 98 99 push @new_others, $field->nested_name; 100 } 101 else { 102 push @new_others, $name; 103 } 104 } 105 106 $self->attach_errors_to( \@new_others ); 107 } 108}; 109 110sub mk_errors { 111 my ( $self, $args ) = @_; 112 113 my $pass = $args->{pass}; 114 my @failed = $args->{failed} ? @{ $args->{failed} } : (); 115 my @names = $args->{names} ? @{ $args->{names} } : (); 116 117 my $force = $self->force_errors || $self->parent->force_errors; 118 119 DEBUG_CONSTRAINTS_OTHERS && debug( PASS => $pass ); 120 DEBUG_CONSTRAINTS_OTHERS && debug( NAMES => \@names ); 121 DEBUG_CONSTRAINTS_OTHERS && debug( 'FAILED NAMES' => \@failed ); 122 DEBUG_CONSTRAINTS_OTHERS && debug( FORCE => $force ); 123 124 if ( $pass && !$force ) { 125 DEBUG_CONSTRAINTS_OTHERS 126 && debug( 127 'constraint passed, or force_errors is false - returning no errors' 128 ); 129 return; 130 } 131 132 my @can_error; 133 my @has_error; 134 135 if ( $self->attach_errors_to ) { 136 push @can_error, @{ $self->attach_errors_to }; 137 138 if ( !$pass ) { 139 push @has_error, @{ $self->attach_errors_to }; 140 } 141 } 142 elsif ( $self->attach_errors_to_base ) { 143 push @can_error, $self->nested_name; 144 145 if ( !$pass ) { 146 push @has_error, $self->nested_name; 147 } 148 } 149 elsif ( $self->attach_errors_to_others ) { 150 push @can_error, ref $self->others 151 ? @{ $self->others } 152 : $self->others; 153 154 if ( !$pass ) { 155 push @has_error, ref $self->others 156 ? @{ $self->others } 157 : $self->others; 158 } 159 } 160 else { 161 push @can_error, @names; 162 163 if ( !$pass ) { 164 push @has_error, @failed; 165 } 166 } 167 168 DEBUG_CONSTRAINTS_OTHERS && debug( 'CAN ERROR' => \@can_error ); 169 DEBUG_CONSTRAINTS_OTHERS && debug( 'HAS ERROR' => \@has_error ); 170 171 my @errors; 172 173 for my $name (@can_error) { 174 175 next unless $force || grep { $name eq $_ } @has_error; 176 177 DEBUG_CONSTRAINTS_OTHERS && debug( 'CREATING ERROR' => $name ); 178 179 my $field = $self->form->get_field( { nested_name => $name } ) 180 or die "others() field not found: '$name'"; 181 182 my $error = $self->mk_error; 183 184 $error->parent($field); 185 186 if ( !grep { $name eq $_ } @has_error ) { 187 DEBUG_CONSTRAINTS_OTHERS 188 && debug("setting '$name' error forced(1)"); 189 190 $error->forced(1); 191 } 192 193 push @errors, $error; 194 } 195 196 return @errors; 197} 198 199around clone => sub { 200 my ( $orig, $self, $args ) = @_; 201 202 my $clone = $self->$orig($args); 203 204 if ( ref $self->others ) { 205 $clone->others( Clone::clone( $self->others ) ); 206 } 207 208 return $clone; 209}; 210 2111; 212 213__END__ 214 215=pod 216 217=encoding UTF-8 218 219=head1 NAME 220 221HTML::FormFu::Role::Constraint::Others - Base class for constraints needing others() method 222 223=head1 VERSION 224 225version 2.07 226 227=head1 METHODS 228 229=head2 others 230 231Arguments: \@nested_names 232 233=head2 other_siblings 234 235Arguments: $bool 236 237If true, the L</others> list will be automatically generated from the 238C<nested_name> of all fields which are considered siblings of the field the 239constraint is attached to. 240 241Sibling are found by searching up through the field's parental hierarchy for 242the first block containing any other field. All fields attached at any depth 243to this block are considered siblings. 244 245=head2 attach_errors_to_base 246 247If true, any error will cause the error message to be associated with the 248field the constraint is attached to. 249 250Can be use in conjunction with L</attach_errors_to_others>. 251 252Is ignored if L</attach_errors_to> is set. 253 254=head2 attach_errors_to_others 255 256If true, any error will cause the error message to be associated with every 257field named in L</others>. 258 259Can be use in conjunction with L</attach_errors_to_base>. 260 261Is ignored if L</attach_errors_to> is set. 262 263=head2 attach_errors_to 264 265Arguments: \@field_names 266 267Any error will cause the error message to be associated with every field 268named in L</attach_errors_to>. 269 270Overrides L</attach_errors_to_base> and L</attach_errors_to_others>. 271 272=head1 SEE ALSO 273 274Is a sub-class of, and inherits methods from L<HTML::FormFu::Constraint> 275 276L<HTML::FormFu> 277 278=head1 AUTHOR 279 280Carl Franks C<cfranks@cpan.org> 281 282=head1 LICENSE 283 284This library is free software, you can redistribute it and/or modify it under 285the same terms as Perl itself. 286 287=head1 AUTHOR 288 289Carl Franks <cpan@fireartist.com> 290 291=head1 COPYRIGHT AND LICENSE 292 293This software is copyright (c) 2018 by Carl Franks. 294 295This is free software; you can redistribute it and/or modify it under 296the same terms as the Perl 5 programming language system itself. 297 298=cut 299