1 package # hide from PAUSE
2 DBIx::Class::CDBICompat::Constraints;
4 use base 'DBIx::Class';
11 my $col = $class->find_column(+shift)
12 or return $class->throw_exception("constraint_column needs a valid column");
14 or return $class->throw_exception("constrain_column needs a constraint");
15 if (ref $how eq "ARRAY") {
16 my %hash = map { $_ => 1 } @$how;
17 $class->add_constraint(list => $col => sub { exists $hash{ +shift } });
18 } elsif (ref $how eq "Regexp") {
19 $class->add_constraint(regexp => $col => sub { shift =~ $how });
21 $how =~ m/([^:]+)$/; # match is safe - we throw above on empty $how
22 my $try_method = sprintf '_constrain_by_%s', lc $1; # $how->moniker;
23 if (my $dispatch = $class->can($try_method)) {
24 $class->$dispatch($col => ($how, @_));
26 $class->throw_exception("Don't know how to constrain $col with $how");
33 $class->_invalid_object_method('add_constraint()') if ref $class;
34 my $name = shift or return $class->throw_exception("Constraint needs a name");
35 my $column = $class->find_column(+shift)
36 or return $class->throw_exception("Constraint $name needs a valid column");
38 or return $class->throw_exception("Constraint $name needs a code reference");
39 return $class->throw_exception("Constraint $name '$code' is not a code reference")
40 unless ref($code) eq "CODE";
42 #$column->is_constrained(1);
44 "before_set_$column" => sub {
45 my ($self, $value, $column_values) = @_;
46 $code->($value, $self, $column, $column_values)
47 or return $self->throw_exception(
48 "$class $column fails '$name' constraint with '$value'");