From eddbde83bd47c0318fcb9cd5dcf9eaa1bdc7307b Mon Sep 17 00:00:00 2001 From: TLINDEN Date: Thu, 6 Nov 2014 00:07:03 +0100 Subject: [PATCH] added: global validators, dynamic validators with arguments, new builtin type range(start-end) --- Changelog | 23 ++++++--- Struct.pm | 140 +++++++++++++++++++++++++++++++++++++++++++++--------- t/run.t | 14 +++++- 3 files changed, 147 insertions(+), 30 deletions(-) diff --git a/Changelog b/Changelog index 6c1c7e3..8ad4743 100644 --- a/Changelog +++ b/Changelog @@ -1,11 +1,22 @@ 0.08 o applied patches by Per Carlson: - don't die on 1st error, rather collect them and - and issue a full report + issue a full report - use errors() to retrieve all those collected errors - enhanced unit tests - proper utf8 handling - - lots of minor tweaks (typos, ambuities and such) + - lots of minor tweaks (typos, ambiguities and such) + + o added support for dynamic arguments to validators, + which is used by the new range type, see below. + arguments passed to coderefs: val, unparsed args, array + of args tokenized by , or -. + + o added new builtin validator type: range(start-end), + use it like: { loginport => range(22-23) }. + + o export a class method add_validators() [only if requested], + which can be used to add validator types globally. 0.07 o lost [updated 11/2014] @@ -34,7 +45,7 @@ o started with 0.x version numbering to show the early stage of the module. - + o added ipv6 type o fixed several bugs with existing types. Thanks to @@ -47,12 +58,12 @@ 1.03 o oops - forgot to increase version number, therefore CPAN didn't get it. - + 1.02 o removed inheritance of Config::General, which is senceless - + 1.01 o added Regex::Common support - + 1.00 o initial release diff --git a/Struct.pm b/Struct.pm index c8cad63..6fd67f4 100644 --- a/Struct.pm +++ b/Struct.pm @@ -23,28 +23,21 @@ use Data::Validate::IP qw(is_ipv4 is_ipv6); our $VERSION = 0.08; -use vars qw(@ISA); +use vars qw(@ISA); -sub new { - my ($class, $structure) = @_; - $class = ref($class) || $class; +use vars qw(@ISA @EXPORT @EXPORT_OK %__ValidatorTypes); +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(%__ValidatorTypes); +@EXPORT_OK = qw(add_validators); - my $self = bless {}, $class; - - $self->{structure} = $structure; - - # if types will be implemented in Data::Validate, remove our own - # types from here and use Data::Validate's methods as subroutine - # checks, which we already support. - $self->{types} = { +%__ValidatorTypes = ( # primitives int => sub { return defined(is_integer($_[0])); }, hex => sub { return defined(is_hex($_[0])); }, oct => sub { return defined(is_oct($_[0])); }, - - # FIXME: add is_between argumented types, need more than one argument - number => sub { return defined(is_numeric($_[0])); }, + word => qr(^[\w_\-]+$), line => qr/^[^\n]+$/s, @@ -102,16 +95,44 @@ sub new { group => sub { return getgrnam($_[0]); }, # int between 0 - 65535 - port => sub { if ( $_[0] =~ /^$port$/ && ($_[0] > 0 && $_[0] < 65535) ) { return 1; } else { return 0; } }, + port => sub { + if ( $_[0] =~ /^$port$/ && ($_[0] > 0 && $_[0] < 65535) ) + { return 1; } else { return 0; } }, + + # variable integer range, use: range(N1 - N2) + range => sub { + if ( defined(is_integer($_[0])) && ($_[0] >= $_[2] && $_[0] <= $_[3]) ) + { return 1; } else { return 0; } }, # just a place holder at make the key exist optional => 1, - }; +); +sub add_validators { + # class method, add validators globally, not per object + my(%v) = @_; + foreach my $type (keys %v) { + $__ValidatorTypes{$type} = $v{$type}; + } +} + +sub new { + my ($class, $structure) = @_; + $class = ref($class) || $class; + + my $self = bless {}, $class; + + $self->{structure} = $structure; + + # if types will be implemented in Data::Validate, remove our own + # types from here and use Data::Validate's methods as subroutine + # checks, which we already support. + $self->{types} = \%__ValidatorTypes; + $self->{debug} = 0; $self->{errors} = []; - foreach my $type (%{$self->{types}}) { + foreach my $type (keys %{$self->{types}}) { # add negative match types $self->{types}->{'no' . $type} = $self->{types}->{$type}; } @@ -204,9 +225,10 @@ sub _traverse { sub _check_type { my ($self, $key, $reference, $hash) = @_; - my @types = _trim( (split /\|/, $reference->{$key}) ); + my (@types, @tmptypes, @tokens); + @types = @tmptypes = _trim( (split /\|/, $reference->{$key}) ); # check data types - if (grep { ! exists $self->{types}->{$_} } @types) { + if (grep { ! exists $self->{types}->{$_} } map { s/\(.*//; $_ } @tmptypes) { return "Invalid data type '$reference->{$key}'"; } @@ -233,6 +255,10 @@ sub _check_type { # skip optional data type (can't be compared) next if $type eq 'optional'; + # tokenize the type into params, only used by coderefs + # passed to coderef: &code($value, $typename, $unparsed_args, $arg1, $arg2 ...) + ($type, @tokens) = _tokenize($type); + # if the type begins with 'no' AND the remainder of the type # also exists in the type hash, we are expects something that is # FALSE (0), else TRUE (1). @@ -249,7 +275,7 @@ sub _check_type { # type conversions are needed. my $result = ref($self->{types}->{$type}) eq q(CODE) # the the type is a code ref, execute the code - ? &{$self->{types}->{$type}}($value) ? 1 : 0 + ? &{$self->{types}->{$type}}($value, @tokens) ? 1 : 0 # else it's an regexp, check if it's a match : $value =~ /$self->{types}->{$type}/ ? 1 : 0; @@ -278,6 +304,23 @@ sub _trim { return wantarray ? @a : $a[0]; } +sub _tokenize { + my $type = shift; + + if ($type =~ /(.+?)\((.+?)\)/) { + print "func pattern\n"; + # type matches a function like pattern eg highport(1-1023) + my $name = $1; + my $args = $2; + $args =~ s/\s//g; + my @params = split /[\,\-]/, $args; + return ($name, $args, @params); + } + print "nofunc <$type>\n"; + # default, just return the name as it is + return ($type); +} + 1; @@ -324,6 +367,12 @@ so you need to install it too. Match a simple integer number. +=item B + +Match a simple integer number in a range between a and b. Eg: + + { loginport => 'range(22-23)' } + =item B Match a hex value. @@ -618,7 +667,38 @@ are really simple. 'address' is a regex which matches a word followed by an integer. 'list' is a subroutine which gets called during evaluation for each option which you define as type 'list'. -Such subroutines must return a true value in order to produce a match. +Such a subroutine must return a true value in order to produce a match. +It receives the following arguments: + +=over + +=item value to be evaluated + +=item unparsed arguments, if defined in the reference + +=item array of parsed arguments, tokenized by , and - + +=back + +That way you may define a type which accepts an arbitrary number +of arguments, which makes the type customizable. Sample: + + # new validator + $v4 = Data::Validate::Struct->new({ list => nwords(4) }); + + # define type 'nwords' with support for 1 argument + $v4->type( + nwords => sub { + my($val, $ignore, $count) = @_; + return (scalar(split /\s+/, $val) == $count) ? 1 : 0; + }, + ); + + # validate + $v4->validate({ list => 'these are four words' }); + +It is also possible to add validators globally so they are +available during repeated calls to B, see B. A negative/reverse match is automatically added as well, see L. @@ -628,7 +708,7 @@ will be used by the module. Eg. if you want to match the whole value from beginning to the end, add ^ and $, like you can see in our 'address' example above. -C do accept either a hash (C<%hash>), a hash ref (C<%$hash>) or a +C does accept either a hash (C<%hash>), a hash ref (C<%$hash>) or a list of key/values (C<< key => value >>) as input. =item B @@ -649,6 +729,20 @@ about what happened. The format is like in L. =back +=head1 EXPORTED FUNCTIONS + +=head2 add_validators + +This is a class function which adds types not per object +but globally for each instance of Data::Validate::Struct. + + use Data::Validate::Struct qw(add_validators); + add_validators( name => .. ); + my $v = Data::Validate::Struct->new(..); + +Parameter to B are the same as of the +B method. + =head1 EXAMPLES Take a look to F for lots of examples. diff --git a/t/run.t b/t/run.t index c7b1ddd..383678f 100644 --- a/t/run.t +++ b/t/run.t @@ -56,6 +56,8 @@ my $ref = { son => { fullname => 'text', user => 'word' }, daughter => { fullname => 'text', user => 'word' }, }, + + 'r1' => 'range(80-90)', }; my $cfg = { @@ -118,6 +120,8 @@ my $cfg = { son => { fullname => 'Bart Simpson', user => 'bart' }, daughter => { fullname => 'Lisa Simpson', user => 'lisa' }, }, + + 'r1' => 85, }; my $v = new_ok('Data::Validate::Struct', [ $ref ]); @@ -314,12 +318,19 @@ my @failure = ( errors => 1, }, + { + cfg => 100, + type => 'range(200-1000)', + descr => 'value outside dynamic range', + errors => 1, + }, + ); foreach my $test (@failure) { my $ref = { v => $test->{type} }; my $cfg = { v => $test->{cfg} }; - my $v = new Data::Validate::Struct($ref); + my $v = Data::Validate::Struct->new($ref); #$v->debug(); my $result = $v->validate($cfg); my $descr = encode('UTF-8', @@ -334,6 +345,7 @@ foreach my $test (@failure) { } } + # clean old object undef $v; $v = Data::Validate::Struct->new({