view release on metacpan or  search on metacpan

t/10base.t  view on Meta::CPAN

use t::boilerplate;

use Test::More;
use Class::Null;
use English qw( -no_match_vars );
use Unexpected;

use_ok 'Data::Validation';
use_ok 'Data::Validation::Constants';

sub new_e {
   my $config    = shift;
   my $validator = Data::Validation->new( %{ $config } );
   my $value     = eval { $validator->check_field( @_ ) };

   return $value, Data::Validation::Exception->caught();
}

sub test_val {
   my ($value, $e) = new_e( @_ );

   $e and $e->instance_of( 'Data::Validation::Exception' )
      and $e->class ne 'Data::Validation::Exception' and return $e->class;

   if ($e) { $e = $e->as_string; chomp $e; return $e }

   return $value;
}

my $f = {};

is test_val( $f, undef, 1 ), "Field '[?]' validation configuration not found",
   'No field def 1';
is test_val( $f, 'test', 1), "Field 'test' validation configuration not found",
   'No field def 2';

$f->{fields}->{test}->{validate} = q(isHexadecimal);
is test_val( $f, q(test), q(alive) ), q(Hexadecimal), 'Not hexadecimal';
is test_val( $f, q(test), q(dead) ),  q(dead),         'Is hexadecimal';

my ($value, $e) = new_e( $f, q(test), q(alive) );

like $e->explain, qr{ \Qcan only contain\E }imx, 'Explains error';

$f->{fields}->{test}->{validate} = q(isMandatory);
is test_val( $f, q(test), undef ), q(Mandatory), 'Missing field';
is test_val( $f, q(test), 1 ),     q(1),       'Mandatory field';

($value, $e) = new_e( $f, q(test), undef );
is $e->explain, q(), 'Default explain';

$f->{fields}->{test}->{validate} = q(isPrintable);
is test_val( $f, q(test), q(
) ),   q(Printable), 'Not printable';
is test_val( $f, q(test), q(q; *) ), q(q; *),          'Printable';

$f->{fields}->{test}->{validate} = q(isSimpleText);
is test_val( $f, q(test), q(*3$%^) ),        q(SimpleText), 'Not simple text';
is test_val( $f, q(test), q(this is text) ), q(this is text),   'Simple text';

SKIP: {
   $f->{fields}->{test}->{validate} = q(isValidHostname);

   (test_val( $f, q(test), q(example.com)        ) eq q(example.com)   and
    test_val( $f, q(test), q(google.com)         ) eq q(google.com)    and
    test_val( $f, q(test), q(does_not_exist)     ) eq q(ValidHostname) and
    test_val( $f, q(test), q(does_not_exist.com) ) eq q(ValidHostname) and
    test_val( $f, q(test), q(does.not.exist.com) ) eq q(ValidHostname) and
    test_val( $f, q(test), q(does.not.exist.example.com) ) eq q(ValidHostname))
      or skip 'valid hostname test - Broken resolver', 8;

   is test_val( $f, q(test), q(does_not_exist) ), q(ValidHostname),
      'Invalid hostname - does_not_exist';
   is test_val( $f, q(test), q(does_not_exist.com) ), q(ValidHostname),
      'Invalid hostname - does_not_exist.com';
   is test_val( $f, q(test), q(does.not.exist.com) ), q(ValidHostname),
      'Invalid hostname - does.not.exist.com';
   is test_val( $f, q(test), q(does.not.exist.example.com) ),
      q(ValidHostname), 'Invalid hostname - does.not.exist.example.com';
   is test_val( $f, q(test), q(127.0.0.1) ), q(127.0.0.1),
      'Valid hostname - 127.0.0.1';
   is test_val( $f, q(test), q(example.com) ), q(example.com),
      'Valid hostname - example.com';
   is test_val( $f, q(test), q(localhost) ), q(localhost),
      'Valid hostname - localhost';
   is test_val( $f, q(test), q(google.com) ), q(google.com),
      'Valid hostname - google.com';
}

$f->{fields}->{test}->{validate} = q(isValidIdentifier);
is test_val( $f, q(test), 1 ),     q(ValidIdentifier), 'Invalid Identifier';
is test_val( $f, q(test), q(x) ),  q(x),               'Valid Identifier';

$f->{fields}->{test}->{validate} = q(isValidNumber isValidInteger);
is test_val( $f, q(test), 1.1 ),   q(ValidInteger), 'Invalid Integer';
is test_val( $f, q(test), q(1a) ), q(ValidNumber),  'Invalid Number';
is test_val( $f, q(test), 1 ),     1,               'Valid Integer';

$f->{fields}->{test}->{validate}
   = q(isValidNumber isValidInteger isBetweenValues);
$f->{constraints}->{test} = { min_value => 2, max_value => 4 };
is test_val( $f, q(test), 5 ), q(BetweenValues), 'Out of range';