1#!/usr/bin/perl -w 2 3use strict; 4 5use Params::Validate qw(validate validate_with); 6use Test::More tests => 5; 7 8my $ucfirst_normalizer = sub { return ucfirst lc $_[0] }; 9 10sub sub1 11{ 12 my %args = validate_with( params => \@_, 13 spec => { PaRaMkEy => 1 }, 14 normalize_keys => $ucfirst_normalizer 15 ); 16 17 return $args{Paramkey}; 18} 19 20sub sub2 21{ 22 # verify that normalize_callback surpresses ignore_case 23 my %args = validate_with( params => \@_, 24 spec => { PaRaMkEy => 1 }, 25 normalize_keys => $ucfirst_normalizer, 26 ignore_case => 1 27 ); 28 29 return $args{Paramkey}; 30} 31 32sub sub3 33{ 34 # verify that normalize_callback surpresses strip_leading 35 my %args = validate_with( params => \@_, 36 spec => { -PaRaMkEy => 1 }, 37 normalize_keys => $ucfirst_normalizer, 38 strip_leading => '-' 39 ); 40 41 return $args{-paramkey}; 42} 43 44sub sub4 45{ 46 my %args = validate_with( params => \@_, 47 spec => { foo => 1 }, 48 normalize_keys => sub { undef } 49 ); 50} 51 52sub sub5 53{ 54 my %args = validate_with( params => \@_, 55 spec => { foo => 1 }, 56 normalize_keys => sub { return 'a' }, 57 ); 58} 59 60ok( eval { sub1( pArAmKeY => 1 ) } ); 61ok( eval { sub2( pArAmKeY => 1 ) } ); 62ok( eval { sub3( -pArAmKeY => 1 ) } ); 63 64eval { sub4( foo => 5 ) }; 65like( $@, qr/normalize_keys.+a defined value/ ); 66 67eval { sub5( foo => 5, bar => 5 ) }; 68like( $@, qr/normalize_keys.+already exists/ ); 69 70