1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211
|
package HTML::FormFu::Role::Constraint::Others;
use Moose::Role;
use HTML::FormFu::Util qw(
DEBUG_CONSTRAINTS
debug
);
use Clone ();
use List::MoreUtils qw( any none );
has others => ( is => 'rw', traits => ['Chained'] );
has other_siblings => ( is => 'rw', traits => ['Chained'] );
has attach_errors_to => ( is => 'rw', traits => ['Chained'] );
has attach_errors_to_base => ( is => 'rw', traits => ['Chained'] );
has attach_errors_to_others => ( is => 'rw', traits => ['Chained'] );
sub pre_process {
my ($self) = @_;
if ( $self->other_siblings ) {
my $field = $self->field;
my $block = $field;
# find the nearest parent that contains any field other than
# the one this constraint is attached to
while ( defined( my $parent = $block->parent ) ) {
$block = $parent;
last if grep { $_ ne $field } @{ $block->get_fields };
}
my @names;
for my $sibling (@{ $block->get_fields }) {
next if $sibling == $field;
push @names, $sibling->nested_name;
}
$self->others([@names]);
}
}
sub mk_errors {
my ( $self, $args ) = @_;
my $pass = $args->{pass};
my @failed = $args->{failed} ? @{ $args->{failed} } : ();
my @names = $args->{names} ? @{ $args->{names} } : ();
my $force = $self->force_errors || $self->parent->force_errors;
DEBUG_CONSTRAINTS && debug( PASS => $pass );
DEBUG_CONSTRAINTS && debug( NAMES => \@names );
DEBUG_CONSTRAINTS && debug( 'FAILED NAMES' => \@failed );
DEBUG_CONSTRAINTS && debug( FORCE => $force );
if ( $pass && !$force ) {
DEBUG_CONSTRAINTS
&& debug(
'constraint passed, or force_errors is false - returning no errors'
);
return;
}
my @can_error;
my @has_error;
if ( $self->attach_errors_to ) {
push @can_error, @{ $self->attach_errors_to };
if ( !$pass ) {
push @has_error, @{ $self->attach_errors_to };
}
}
elsif ( $self->attach_errors_to_base ) {
push @can_error, $self->nested_name;
if ( !$pass ) {
push @has_error, $self->nested_name;
}
}
elsif ( $self->attach_errors_to_others ) {
push @can_error, ref $self->others
? @{ $self->others }
: $self->others;
if ( !$pass ) {
push @has_error, ref $self->others
? @{ $self->others }
: $self->others;
}
}
else {
push @can_error, @names;
if ( !$pass ) {
push @has_error, @failed;
}
}
DEBUG_CONSTRAINTS && debug( 'CAN ERROR' => \@can_error );
DEBUG_CONSTRAINTS && debug( 'HAS ERROR' => \@has_error );
my @errors;
for my $name (@can_error) {
next unless $force || grep { $name eq $_ } @has_error;
DEBUG_CONSTRAINTS && debug( 'CREATING ERROR' => $name );
my $field = $self->form->get_field( { nested_name => $name } )
or die "others() field not found: '$name'";
my $error = $self->mk_error;
$error->parent($field);
if ( !grep { $name eq $_ } @has_error ) {
DEBUG_CONSTRAINTS && debug("setting '$name' error forced(1)");
$error->forced(1);
}
push @errors, $error;
}
return @errors;
}
around clone => sub {
my ( $orig, $self, $args ) = @_;
my $clone = $self->$orig( $args );
if ( ref $self->others ) {
$clone->others( Clone::clone( $self->others ) );
}
return $clone;
};
1;
__END__
=head1 NAME
HTML::FormFu::Constraint::_others - Base class for constraints needing others() method
=head1 METHODS
=head2 others
Arguments: \@nested_names
=head2 other_siblings
Arguments: $bool
If true, the L</others> list will be automatically generated from the
C<nested_name> of all fields which are considered siblings of the field the
constraint is attached to.
Sibling are found by searching up through the field's parental hierarchy for
the first block containing any other field. All fields attached at any depth
to this block are considered siblings.
=head2 attach_errors_to_base
If true, any error will cause the error message to be associated with the
field the constraint is attached to.
Can be use in conjunction with L</attach_errors_to_others>.
Is ignored if L</attach_errors_to> is set.
=head2 attach_errors_to_others
If true, any error will cause the error message to be associated with every
field named in L</others>.
Can be use in conjunction with L</attach_errors_to_base>.
Is ignored if L</attach_errors_to> is set.
=head2 attach_errors_to
Arguments: \@field_names
Any error will cause the error message to be associated with every field
named in L</attach_errors_to>.
Overrides L</attach_errors_to_base> and L</attach_errors_to_others>.
=head1 SEE ALSO
Is a sub-class of, and inherits methods from L<HTML::FormFu::Constraint>
L<HTML::FormFu>
=head1 AUTHOR
Carl Franks C<cfranks@cpan.org>
=head1 LICENSE
This library is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
|