Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
AbstractSearch.pm	1.09 KB	-rw-rw-rw-	2020-03-29 22:33
AccessorMapping.pm	2.01 KB	-rw-rw-rw-	2020-03-29 22:33
AttributeAPI.pm	668 B	-rw-rw-rw-	2020-03-29 22:33
AutoUpdate.pm	900 B	-rw-rw-rw-	2020-03-29 22:33
ColumnCase.pm	1.98 KB	-rw-rw-rw-	2020-03-29 22:33
ColumnGroups.pm	4.43 KB	-rw-rw-rw-	2020-03-29 22:33
ColumnsAsHash.pm	2.57 KB	-rw-rw-rw-	2020-03-29 22:33
Constraints.pm	1.77 KB	-rw-rw-rw-	2020-03-29 22:33
Constructor.pm	673 B	-rw-rw-rw-	2020-03-29 22:33
Copy.pm	1.06 KB	-rw-rw-rw-	2020-03-29 22:33
DestroyWarning.pm	451 B	-rw-rw-rw-	2020-03-29 22:33
GetSet.pm	639 B	-rw-rw-rw-	2020-03-29 22:33
ImaDBI.pm	3.85 KB	-rw-rw-rw-	2020-03-29 22:33
Iterator.pm	1.59 KB	-rw-rw-rw-	2020-03-29 22:33
LazyLoading.pm	2.84 KB	-rw-rw-rw-	2020-03-29 22:33
LiveObjectIndex.pm	2.48 KB	-rw-rw-rw-	2020-03-29 22:33
NoObjectIndex.pm	1.03 KB	-rw-rw-rw-	2020-03-29 22:33
Pager.pm	499 B	-rw-rw-rw-	2020-03-29 22:33
ReadOnly.pm	288 B	-rw-rw-rw-	2020-03-29 22:33
Relationship.pm	1.08 KB	-rw-rw-rw-	2020-03-29 22:33
Relationships.pm	5.45 KB	-rw-rw-rw-	2020-03-29 22:33
Retrieve.pm	1.94 KB	-rw-rw-rw-	2020-03-29 22:33
SQLTransformer.pm	3.16 KB	-rw-rw-rw-	2020-03-29 22:33
Stringify.pm	451 B	-rw-rw-rw-	2020-03-29 22:33
TempColumns.pm	2.2 KB	-rw-rw-rw-	2020-03-29 22:33
Triggers.pm	971 B	-rw-rw-rw-	2020-03-29 22:33

Rename

package # hide from PAUSE
    DBIx::Class::CDBICompat::Constraints;

use strict;
use warnings;

sub constrain_column {
  my $class = shift;
  my $col   = $class->find_column(+shift)
    or return $class->throw_exception("constraint_column needs a valid column");
  my $how = shift
    or return $class->throw_exception("constrain_column needs a constraint");
  if (ref $how eq "ARRAY") {
    my %hash = map { $_ => 1 } @$how;
    $class->add_constraint(list => $col => sub { exists $hash{ +shift } });
  } elsif (ref $how eq "Regexp") {
    $class->add_constraint(regexp => $col => sub { shift =~ $how });
  } else {
    $how =~ m/([^:]+)$/; # match is safe - we throw above on empty $how
    my $try_method = sprintf '_constrain_by_%s', lc $1; # $how->moniker;
    if (my $dispatch = $class->can($try_method)) {
      $class->$dispatch($col => ($how, @_));
    } else {
      $class->throw_exception("Don't know how to constrain $col with $how");
    }
  }
}

sub add_constraint {
  my $class = shift;
  $class->_invalid_object_method('add_constraint()') if ref $class;
  my $name = shift or return $class->throw_exception("Constraint needs a name");
  my $column = $class->find_column(+shift)
    or return $class->throw_exception("Constraint $name needs a valid column");
  my $code = shift
    or return $class->throw_exception("Constraint $name needs a code reference");
  return $class->throw_exception("Constraint $name '$code' is not a code reference")
    unless ref($code) eq "CODE";

#$column->is_constrained(1);
  $class->add_trigger(
    "before_set_$column" => sub {
      my ($self, $value, $column_values) = @_;
      $code->($value, $self, $column, $column_values)
        or return $self->throw_exception(
        "$class $column fails '$name' constraint with '$value'");
    }
  );
}