DEBUG_CONSTRAINTS
debug
)
;
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
;
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;