view release on metacpan or  search on metacpan

t/validate.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use Storable 'dclone';
use Test::More;

eval { require boolean; }; # Optional test, a blessed 'boolean' reference overloads some contexts, we should be able to handle that.

BEGIN { use_ok 'TUWF::Validate', qw/compile validate/ };


my %validations = (
  hex => { regex => qr/^[0-9a-f]*$/i },
  prefix => sub { my $p = shift; { func => sub { $_[0] =~ /^$p/ } } },
  bool => { default => 0, func => sub { $_[0] = $_[0]?1:0; 1 } },
  setundef => { func => sub { $_[0] = undef; 1 } },
  defaultsub1 => { default => sub { 2 } },
  defaultsub2 => { default => sub { defined $_[0] } },
  onerrorsub => { onerror => sub { ref $_[0] } },
  collapsews => { rmwhitespace => 0, func => sub { $_[0] =~ s/\s+/ /g; 1 } },
  neverfails => { onerror => 'err' },
  revnum => { type => 'array', sort => sub { $_[1] <=> $_[0] } },
  uniquelength => { type => 'array', values => { type => 'array' }, unique => sub { scalar @{$_[0]} } },
  person => {
    type => 'hash',
    unknown => 'pass',
    keys => {
      name => {},
      age => { missing => 'ignore' },
      sex => { missing => 'reject', default => 1 }
    }
  },
);


sub t {
  my($schema, $input, $output, $error) = @_;
  my $line = (caller)[2];

  my $schema_copy = dclone([$schema])->[0];
  my $input_copy = dclone([$input])->[0];

  my $res = validate \%validations, $schema, $input;
  #diag explain $res if $line == 82;
  is !!$res, !$error, "boolean context $line";
  is_deeply $schema, $schema_copy, "schema modification $line";
  is_deeply $input,  $input_copy,  "input modification $line";
  is_deeply $res->unsafe_data(), $output, "unsafe_data $line";
  is_deeply $res->data(), $output, "data ok $line" if !$error;
  ok !eval { $res->data; 1}, "data err $line" if $error;
  is_deeply $res->err(), $error, "err $line";

  my $res_b = compile(\%validations, $schema)->validate($input);
  is_deeply $schema, $schema_copy, "compile+validate schema modification $line";
  is_deeply $input,  $input_copy,  "compile+validate input modification $line";
  is_deeply $res_b->unsafe_data(), $output, "compile+validate unsafe_data $line";
  is_deeply $res_b->err(), $error, "compile+validate err $line";
}


# default
t {}, 0, 0, undef;
t {}, '', '', { validation => 'required' };
t {}, undef, undef, { validation => 'required' };
t { default => undef }, undef, undef, undef;
t { default => undef }, '', undef, undef;
t { defaultsub1 => 1 }, undef, 2, undef;
t { defaultsub2 => 1 }, undef, '', undef;
t { defaultsub2 => 1 }, '', 1, undef;
t { onerrorsub => 1 }, undef, 'TUWF::Validate::Result', undef;

# rmwhitespace
t {}, " Va\rl id \n ", 'Val id', undef;
t { rmwhitespace => 0 }, " Va\rl id \n ", " Va\rl id \n ", undef;
t {}, '  ', '', { validation => 'required' };
t { rmwhitespace => 0 }, '  ', '  ', undef;

# arrays
t {}, [], [], { validation => 'type', expected => 'scalar', got => 'array' };
t { type => 'array' }, 1, 1, { validation => 'type', expected => 'array', got => 'scalar' };
t { type => 'array' }, [], [], undef;
t { type => 'array' }, [undef,1,2,{}], [undef,1,2,{}], undef;
t { type => 'array', scalar => 1 }, 1, [1], undef;
t { type => 'array', values => {} }, [undef], [undef], { validation => 'values', errors => [{ index => 0, validation => 'required' }] };
t { type => 'array', values => {} }, [' a '], ['a'], undef;
t { type => 'array', sort => 'str' }, [qw/20 100 3/], [qw/100 20 3/], undef;
t { type => 'array', sort => 'num' }, [qw/20 100 3/], [qw/3 20 100/], undef;
t { revnum => 1 },                    [qw/20 100 3/], [qw/100 20 3/], undef;
t { type => 'array', sort => 'num', unique => 1 }, [qw/3 2 1/], [qw/1 2 3/], undef;
t { type => 'array', sort => 'num', unique => 1 }, [qw/3 2 3/], [qw/2 3 3/], { validation => 'unique', index_a => 1, value_a => 3, index_b => 2, value_b => 3 };
t { type => 'array', unique => 1 }, [qw/3 1 2/], [qw/3 1 2/], undef;
t { type => 'array', unique => 1 }, [qw/3 1 3/], [qw/3 1 3/], { validation => 'unique', index_a => 0, value_a => 3, index_b => 2, value_b => 3, key => 3 };
t { uniquelength => 1 }, [[],[1],[1,2]], [[],[1],[1,2]], undef;
t { uniquelength => 1 }, [[],[1],[2]], [[],[1],[2]], { validation => 'unique', index_a => 1, value_a => [1], index_b => 2, value_b => [2], key => 1 };
t { type => 'array', setundef => 1 }, [], undef, undef;
t { type => 'array', values => { type => 'any', setundef => 1 } }, [[]], [undef], undef;

# hashes