DBIx-Class-Validation-Structure

 view release on metacpan or  search on metacpan

lib/DBIx/Class/Validation/Structure.pm  view on Meta::CPAN

    # and the primary columns haven't changed
    next if $constraint eq 'primary' and $self->in_storage and not primary_cols_have_changed($self);

    my $search = {
      map {
        next unless ( not keys %$check_columns ) or $check_columns->{$_};
        ($_ => $data->{$_}) } @{ $unique_constraints{$constraint} }
    };

    # Exclude this entries primary keys to the search for dupes
    # to not detect itself when updating.
    unless ( $constraint eq 'primary' ) {
      for my $column ( $source->primary_columns ) {
        $search->{$column} = {
          '!=' => $data->{$column},
        };
      }
    }

    # If there is an entry with the combined value defined above...
    if ( $source->resultset->count($search) ) {
      foreach my $key ( @{ $unique_constraints{$constraint} } ) {
        $errors{$key} = [] unless defined $errors{$key};
        my @other_fields = @{ $unique_constraints{$constraint} };
        # Remove the field so we get a list of other fields in the
        # combination
        my $index = 0;
        $index++ until $other_fields[$index] eq $key;
        splice(@other_fields, $index, 1);
        # If there are no keys other than the key that isnt unique,
        # then write the error as singular else explain the combination.
        if ( $#other_fields >= 0 ) {
          push @{$errors{$key}}, { $key => 'must be unique when combined with '.join(', ',@other_fields) };
        } else {
          push @{$errors{$key}}, { $key => 'must be unique' };
        }
      }
    }
  }

  if ( %errors ) {
    # Convert hash into the array of hashrefs like the validate returns
    return map { { $_ => join( ' and ', map { values %$_ } @{ $errors{$_} } ) } } keys %errors;
  } else {
    return ();
  }
}

sub insert {
   my $self = shift;
   my $result = $self->validate;
   # If errors return the result
   if ($result->{errors}) {
      return $result;
   } else {
   # Else do the normal insert
      $self->next::method(@_);
   }
}

sub update {
   my $self = shift;
   my $columns = shift;

   $self->set_inflated_columns($columns) if $columns;

   my $result = $self->validate;
   # If errors return the result
   if ($result->{errors}) {
      return $result;
   } else {
      # Else do the normal update
      $self->next::method(@_);
   }
}

# =============== Validatators ===============

sub _val_email {
  my ($mand, $value) = @_;
   if (not defined $value) { $value = ''; }
  if ( !Email::Valid->address($value) && $mand ) {
    return ( undef, { msg => 'address is blank or not valid' }  );
  } elsif ( !Email::Valid->address($value) && $value ) {
    return ( undef, { msg => 'address is blank or not valid' }  );
  } else {
    return $value;
  }
}

sub _val_text {
  my ($mand, $len, $value) = @_;

  if ($mand && ( not( defined $value ) or $value eq '' )) {
    return (undef, { msg => 'cannot be blank' });
  } elsif ($len && length($value) && (length($value) > $len) ) {
    return (undef, { msg => 'is limited to '.$len.' characters' });
  } elsif (defined $value && $value !~ /^([\d \.\,\-\'\"\!\$\#\%\=\&\:\+\(\)\[\]\?\;\n\r\<\>\/\@\w]*)$/) {
    return (undef, { msg => 'can only use letters, 0-9 and -.,\'\"!&#$?:()[]=%<>;/@ (do not cut and paste from a Word document, you must Save As text only)' });
  } else {
    # This is to ensure that $1 is from the last regex match
    if (defined $value) {
      return ($1);
    } else {
      return $value;
    }
  }
}

# _val_password is the same as _val_text but it also allows {}s
sub _val_password {
  my ($mand, $len, $value) = @_;

  if ($mand && (!$value || $value =~ /bogus="1"/)) {  #tiny mce
    return (undef, { msg => 'cannot be blank' });
  } elsif ($len && length($value) && (length($value) > $len) ) {
    return (undef, { msg => 'is limited to '.$len.' characters' });
  } elsif ($value && $value !~ /^([\w \.\,\-\'\"\!\$\#\%\=\&\:\+\(\)\[\]\{\}\?\;\n\r\<\>\/\@\w]*)$/) {
    return (undef, { msg => 'can only use letters, 0-9 and -.,\'\"!&#$?:()[]=%<>;/@ (do not cut and paste from a Word document, you must Save As text only)' });
  } else {
    my $tf = new HTML::TagFilter;



( run in 1.348 second using v1.01-cache-2.11-cpan-13bb782fe5a )