lib/DBIx/Class/CDBICompat/Constraints.pm

   1 package # hide from PAUSE
   2     DBIx::Class::CDBICompat::Constraints;
   3
   4 use strict;
   5 use warnings;
   6
   7 sub constrain_column {
   8   my $class = shift;
   9   my $col   = $class->find_column(+shift)
  10     or return $class->throw_exception("constraint_column needs a valid column");
  11   my $how = shift
  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 });
  18   } else {
  19     $how =~ m/([^:]+)$/; # match is safe - we throw above on empty $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, @_));
  23     } else {
  24       $class->throw_exception("Don't know how to constrain $col with $how");
  25     }
  26   }
  27 }
  28
  29 sub add_constraint {
  30   my $class = shift;
  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");
  35   my $code = shift
  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";
  39
  40   #$column->is_constrained(1);
  41   $class->add_trigger(
  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'");
  47     }
  48   );
  49 }
  50
  51 1;