1 package # hide from PAUSE
2 DBIx::Class::CDBICompat::Constraints;
9 my $col = $class->find_column(+shift)
10 or return $class->throw_exception("constraint_column needs a valid column");
12 or return $class->throw_exception("constrain_column needs a constraint");
13 if (ref $how eq "ARRAY") {
14 my %hash = map { $_ => 1 } @$how;
15 $class->add_constraint(list => $col => sub { exists $hash{ +shift } });
16 } elsif (ref $how eq "Regexp") {
17 $class->add_constraint(regexp => $col => sub { shift =~ $how });
20 my $try_method = sprintf '_constrain_by_%s', lc $1; # $how->moniker;
21 if (my $dispatch = $class->can($try_method)) {
22 $class->$dispatch($col => ($how, @_));
24 $class->throw_exception("Don't know how to constrain $col with $how");
31 $class->_invalid_object_method('add_constraint()') if ref $class;
32 my $name = shift or return $class->throw_exception("Constraint needs a name");
33 my $column = $class->find_column(+shift)
34 or return $class->throw_exception("Constraint $name needs a valid column");
36 or return $class->throw_exception("Constraint $name needs a code reference");
37 return $class->throw_exception("Constraint $name '$code' is not a code reference")
38 unless ref($code) eq "CODE";
40 #$column->is_constrained(1);
42 "before_set_$column" => sub {
43 my ($self, $value, $column_values) = @_;
44 $code->($value, $self, $column, $column_values)
45 or return $self->throw_exception(
46 "$class $column fails '$name' constraint with '$value'");