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