Data::Validation - Filter and check data values

   use Data::Validation;

   sub check_field {
      my ($self, $config, $id, $value) = @_;

      my $dv_obj = $self->_build_validation_obj( $config );

      return $dv_obj->check_field( $id, $value );
   }

   sub check_form  {
      my ($self, $config, $form) = @_;

      my $dv_obj = $self->_build_validation_obj( $config );
      my $prefix = $config->{form_name}.q(.);

      return $dv_obj->check_form( $prefix, $form );
   }

   sub _build_validation_obj {
      my ($self, $config) = @_;

      return Data::Validation->new( {
         exception   => $config->{exception_class} || q(Exception::Class),
         constraints => $config->{constraints}     || {},
         fields      => $config->{fields}          || {},
         filters     => $config->{filters}         || {} } );
   }

   $form = $dv->check_form( $prefix, $form );

   $value = $dv->check_field( $id, $value );

# @(#)$Id: Validation.pm 141 2011-04-12 19:47:49Z pjf $

package Data::Validation;

use strict;
use namespace::autoclean;
use version; our $VERSION = qv( sprintf '0.6.%d', q$Rev: 141 $ =~ /\d+/gmx );

use Data::Validation::Constraints;
use Data::Validation::Filters;
use English    qw( -no_match_vars );
use List::Util qw( first );
use Moose;
use Try::Tiny;

has 'exception'   => is => q(ro), isa => q(D_V_Exception), required => 1;
has 'constraints' => is => q(ro), isa => q(HashRef), default => sub { {} };
has 'fields'      => is => q(ro), isa => q(HashRef), default => sub { {} };
has 'filters'     => is => q(ro), isa => q(HashRef), default => sub { {} };
has 'operators'   => is => q(ro), isa => q(HashRef), default => sub {
   return { q(eq) => sub { return $_[0] eq $_[1] },
            q(==) => sub { return $_[0] == $_[1] },
            q(ne) => sub { return $_[0] ne $_[1] },
            q(!=) => sub { return $_[0] != $_[1] },
            q(>)  => sub { return $_[0] >  $_[1] },
            q(>=) => sub { return $_[0] >= $_[1] },
            q(<)  => sub { return $_[0] <  $_[1] },
            q(<=) => sub { return $_[0] <= $_[1] }, } };

sub check_form {
   # Validate all the fields on a form by repeated calling check_field
   my ($self, $prefix, $form) = @_; my @errors = (); $prefix ||= q();

   ($form and ref $form eq q(HASH))
      or $self->exception->throw( 'Form has no values' );

   for my $name (sort keys %{ $form }) {
      my $id = $prefix.$name; my $field = $self->fields->{ $id };

      ($field and ($field->{filters} or $field->{validate})) or next;

      try   {
         $form->{ $name } = $self->check_field( $id, $form->{ $name } );
         __should_compare( $field )
            and $self->_compare_fields( $prefix, $form, $name );
      }
      catch { push @errors, $_ };
   }

   @errors and $self->exception->throw( error => 'Form validation errors',
                                        args  => \@errors );
   return $form;
}

sub check_field {
   # Validate form field values
   my ($self, $id, $value) = @_; my $field;

   unless ($id and $field = $self->fields->{ $id }
           and ($field->{filters} or $field->{validate})) {
      $self->exception->throw( error => 'Field [_1] undefined',
                               args  => [ $id, $value ] );
   }

   $field->{filters}
      and $value = $self->_filter( $field->{filters}, $id, $value );


   for my $method (__get_methods( $field->{validate} )) {
      $method eq q(compare) or $self->_validate( $method, $id, $value );
   }

   return $value;
}

# Private methods

sub _compare_fields {
   my ($self, $prefix, $form, $name1) = @_; my $name2;

   my $id         = $prefix.$name1;
   my $constraint = $self->constraints->{ $id } || {};

   unless ($name2 = $constraint->{other_field}) {
      my $error = 'Constraint [_1] has no comparison field';

      $self->exception->throw( error => $error, args => [ $id ] );
   }

   my $lhs  = $form->{ $name1 } || q();
   my $rhs  = $form->{ $name2 } || q();
   my $op   = $constraint->{operator} || q(eq);
   my $bool = exists $self->operators->{ $op }
            ? $self->operators->{ $op }->( $lhs, $rhs ) : 0;

   unless ($bool) {
      my $error = $constraint->{error} || 'Field [_1] [_2] field [_3]';

      $self->exception->throw( error => $error,
                               args  => [ $name1, $op, $name2 ] );
   }

   return;
}

sub _filter {
   my ($self, $filters, $id, $value) = @_;

   my $config = $self->filters->{ $id } || {};

   for my $method (__get_methods( $filters )) {
      my %config  = ( method    => $method,
                      exception => $self->exception, %{ $config }, );
      my $dvf_obj = try   { Data::Validation::Filters->new( %config ) }
                    catch { $self->exception->throw( $_ ) };

      $value = $dvf_obj->filter( $value );
   }

   return $value;
}

sub _validate {
   my ($self, $method, $id, $value) = @_;

   my $config     = $self->constraints->{ $id } || {};
   my $error      = $config->{error};
   my %config     = ( method    => $method,
                      exception => $self->exception, %{ $config }, );
   my $constraint = try   { Data::Validation::Constraints->new( %config ) }
                    catch { $self->exception->throw( $_ ) };

   unless ($constraint->validate( $value )) {
      my $name = $self->fields->{ $id }->{fhelp} || $id;

      $error or ($error = $method) =~ s{ \A is }{e}imx;
      $self->exception->throw( error => $error, args => [ $name, $value ] );
   }

   return;
}

# Private subroutines

sub __get_methods {
   return split q( ), $_[ 0 ];
}

sub __should_compare {
   return first { $_ eq q(compare) } __get_methods( $_[ 0 ]->{validate} );
}

__PACKAGE__->meta->make_immutable;

no Moose;

1;

__END__

# Local Variables:
# mode: perl
# tab-width: 3
# End: