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