diff --git a/.woodpecker/build.yaml b/.woodpecker/build.yaml deleted file mode 100644 index 7c5a860..0000000 --- a/.woodpecker/build.yaml +++ /dev/null @@ -1,23 +0,0 @@ -matrix: - include: - # - image: perl:5.22.4-stretch - # - image: perl:5.36.0-slim-bullseye - # - image: perl:5.38.0-slim-bookworm - # - image: perl:5.40.0-slim-bookworm - # - image: perl:5.42.0-slim-bookworm - - image: perl:5.43.5-slim-bookworm - -steps: - test: - when: - event: [push] - image: ${image} - commands: - - apt-get update -y - - apt-get install -y gcc - - cpanm -n Regexp::Common - - cpanm -n Data::Validate - - cpanm -n Data::Validate::IP - - perl Makefile.PL - - make - - make test diff --git a/.woodpecker/release.sh b/.woodpecker/release.sh deleted file mode 100755 index a44513a..0000000 --- a/.woodpecker/release.sh +++ /dev/null @@ -1,54 +0,0 @@ -#!/bin/bash - -# This is my own simple codeberg generic releaser. It takes to -# binaries to be uploaded as arguments and takes every other args from -# env. Works on tags or normal commits (push), tags must start with v. - - -set -e - -die() { - echo $* - exit 1 -} - -if test -z "$DEPLOY_TOKEN"; then - die "token DEPLOY_TOKEN not set" -fi - -git fetch --all - -# determine current tag or commit hash -version="$CI_COMMIT_TAG" -previous="" -log="" -if test -z "$version"; then - version="${CI_COMMIT_SHA:0:6}" - log=$(git log -1 --oneline) -else - previous=$(git tag -l | grep -E "^v" | tac | grep -A1 "$version" | tail -1) - log=$(git log -1 --oneline "${previous}..${version}" | sed 's|^|- |g') -fi - -# release body -printf "# Changes\n\n %s\n" "$log" > body.txt - -# create the release -https --ignore-stdin --check-status -b -A bearer -a "$DEPLOY_TOKEN" POST \ - "https://codeberg.org/api/v1/repos/${CI_REPO_OWNER}/${CI_REPO_NAME}/releases" \ - tag_name="$version" name="Release $version" body=@body.txt > release.json - -# we need the id to upload files -ID=$(jq -r .id < release.json) - -if test -z "$ID"; then - cat release.json - die "failed to create release" -fi - -# actually upload -for file in "$@"; do - https --ignore-stdin --check-status -A bearer -a "$DEPLOY_TOKEN" -f POST \ - "https://codeberg.org/api/v1/repos/${CI_REPO_OWNER}/${CI_REPO_NAME}/releases/$ID/assets" \ - "name=${file}" "attachment@${file}" -done diff --git a/.woodpecker/release.yaml b/.woodpecker/release.yaml deleted file mode 100644 index 596150a..0000000 --- a/.woodpecker/release.yaml +++ /dev/null @@ -1,23 +0,0 @@ -# build release - -steps: - compile: - when: - event: [tag] - image: perl:5.43.5-slim-bookworm - commands: - - perl Makefile.PL - - make - - make dist - - release: - image: alpine:latest - when: - event: [tag] - environment: - DEPLOY_TOKEN: - from_secret: DEPLOY_TOKEN - commands: - - apk update - - apk add --no-cache bash httpie jq git - - .woodpecker/release.sh ${CI_REPO_NAME}-$CI_COMMIT_TAG.tar.gz diff --git a/Changelog b/Changelog deleted file mode 100644 index f5b9780..0000000 --- a/Changelog +++ /dev/null @@ -1,98 +0,0 @@ -0.13 - o rework commit 495fcbc: fix bug#14: do not die when - array ref doesn't match reference, only report. - -0.12 - o revert commit 495fcbc, see #7: breaks backwards - compatibility. - -0.11 - o typos - - o added cpanfile - - o don't die when reference types are different - -0.10 - o fixed RT#101884 - - _trim() only removed 1st whitespace - - optional checks were ineffective if the value was undef -0.09 - o Added AUTHOR, LICENSE and ABSTRACT fields to Makefile.PL - - o Fixed 'Artistic' typo in Makefile.PL - - o fixed cached errors bug - if a validator object has - been used multiple times and if during the first - run some errors occurred, subsequent runs would show - the same error again and again. - -0.08 - o applied patches by Per Carlson: - - don't die on 1st error, rather collect them and - issue a full report - - use errors() to retrieve all those collected errors - - enhanced unit tests - - proper utf8 handling - - 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] - -0.06 - o fixed t/run.t, it used still the old name, all tests - failed therefore. - - o replaced some of the built-in regexes with methods - of Data::Validate(the real one :-) ). - - o added 2 new types: hex and oct. - - -0.05 - o well, against renamed it to Data::Validate::Struct, - because Data::Validate already exists. - - o removed check for 'resolvablehost' because some cpantesters - failed to run it. - - -0.04 - o renamed Config::General::Validate to Data::Validate - because this tells much better what it does. - - 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 - David Cantrell for some very useful hints. - - o added more documentation. - --------------- - Original Config::General::Validate Changelog: - 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/MANIFEST b/MANIFEST deleted file mode 100644 index a88018c..0000000 --- a/MANIFEST +++ /dev/null @@ -1,7 +0,0 @@ -MANIFEST -Makefile.PL -Struct.pm -README -Changelog -META.yml Module meta-data (added by MakeMaker) -META.json Module meta-data (added by MakeMaker) diff --git a/META.json b/META.json deleted file mode 100644 index a851649..0000000 --- a/META.json +++ /dev/null @@ -1,49 +0,0 @@ -{ - "abstract" : "Validate recursive hash structures", - "author" : [ - "Thomas v.Dein ", - "Per Carlson " - ], - "dynamic_config" : 0, - "generated_by" : "ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010", - "license" : [ - "perl_5" - ], - "meta-spec" : { - "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", - "version" : 2 - }, - "name" : "Data-Validate-Struct", - "no_index" : { - "directory" : [ - "t", - "inc" - ] - }, - "prereqs" : { - "build" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "configure" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "runtime" : { - "requires" : { - "Data::Validate" : "0", - "Data::Validate::IP" : "0", - "Regexp::Common" : "0" - } - } - }, - "release_status" : "stable", - "resources" : { - "repository" : { - "url" : "https://codeberg.org/scip/Data-Validate-Struct" - } - }, - "version" : 0.12, -} diff --git a/META.yml b/META.yml deleted file mode 100644 index 3578fd6..0000000 --- a/META.yml +++ /dev/null @@ -1,27 +0,0 @@ ---- -abstract: 'Validate recursive hash structures' -author: - - 'Thomas v.Dein ' - - 'Per Carlson ' -build_requires: - ExtUtils::MakeMaker: '0' -configure_requires: - ExtUtils::MakeMaker: '0' -dynamic_config: 0 -generated_by: 'ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010' -license: perl -meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: '1.4' -name: Data-Validate-Struct -no_index: - directory: - - t - - inc -requires: - Data::Validate: '0' - Data::Validate::IP: '0' - Regexp::Common: '0' -resources: - repository: https://codeberg.org/scip/Data-Validate-Struct -version: 0.12 diff --git a/Makefile.PL b/Makefile.PL deleted file mode 100644 index 4c322ef..0000000 --- a/Makefile.PL +++ /dev/null @@ -1,35 +0,0 @@ -# -# Makefile.PL - build file for Date::Validate::Struct -# -# Copyright (c) 2007-2016 T. v.Dein . -# All Rights Reserved. Std. disclaimer applies. -# Artistic License, same as perl itself. Have fun. -# - -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'Data::Validate::Struct', - VERSION_FROM => 'Struct.pm', - ABSTRACT => 'Validate recursive hash structures', - LICENSE => 'perl', - AUTHOR => [ - 'Thomas v.Dein ', - 'Per Carlson ', - ], - clean => { FILES => '*~ */*~' }, - PREREQ_PM => { - 'Regexp::Common' => 0, - 'Data::Validate' => '0.06', - 'Data::Validate::IP' => '0.18', - }, - dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, - test => { TESTS => 't/*.t' }, - 'META_MERGE' => { - resources => { - repository => 'https://codeberg.org/scip/Data-Validate-Struct', - }, - }, - - ); - diff --git a/README.md b/README.md index 71a2360..34eb8fd 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,9 @@ # Data::Validate::Struct - Validate recursive Hash Structures +> [!CAUTION] +> This software is now being maintained on [Codeberg](https://codeberg.org/scip/Data-Validate-Struct/). + # SYNOPSIS use Data::Validate::Struct; diff --git a/Struct.pm b/Struct.pm deleted file mode 100644 index ba6a288..0000000 --- a/Struct.pm +++ /dev/null @@ -1,914 +0,0 @@ -# -# Copyright (c) 2007-2016 T. v.Dein . -# All Rights Reserved. Std. disclaimer applies. -# Artistic License, same as perl itself. Have fun. -# -# namespace -package Data::Validate::Struct; - -use strict; -use warnings; -use English '-no_match_vars'; -use Carp; -use Exporter; -use Encode qw{ encode }; -use Regexp::Common::URI::RFC2396 qw /$host $port/; -use Regexp::Common qw /URI net delimited/; - -use File::Spec::Functions qw/file_name_is_absolute/; -use File::stat; - -use Data::Validate qw(:math is_printable); -use Data::Validate::IP qw(is_ipv4 is_ipv6); - -our $VERSION = 0.13; - -use vars qw(@ISA); - -use vars qw(@ISA @EXPORT @EXPORT_OK %__ValidatorTypes); -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(%__ValidatorTypes); -@EXPORT_OK = qw(add_validators); - -%__ValidatorTypes = ( - # primitives - int => sub { return defined(is_integer($_[0])); }, - hex => sub { return defined(is_hex($_[0])); }, - oct => sub { return defined(is_oct($_[0])); }, - number => sub { return defined(is_numeric($_[0])); }, - - word => qr(^[\w_\-]+$), - line => qr/^[^\n]+$/s, - - text => sub { return defined(is_printable($_[0])); }, - - regex => sub { - my $r = ref $_[0]; - return 1 if $r eq 'Regexp'; - if ($r eq '') { - # this is a bit loosy but should match most regular expressions - # using the qr() operator, but it doesn't check if the expression - # is valid. we could do this by compiling it, but this would lead - # to exploitation possiblities to programs using the module. - return $_[0] =~ qr/^qr ( (.).*\1 | \(.*\) | \{.*\} ) $/x; - } - return 0; - }, - - # via imported regexes - uri => qr(^$RE{URI}$), - cidrv4 => sub { - my ($p, $l) = split(/\//, $_[0]); - return defined(is_ipv4($p)) && defined(is_between($l, 0, 32)); - }, - ipv4 => sub { defined(is_ipv4($_[0])) }, - quoted => qr/^$RE{delimited}{ -delim => qr(\') }$/, - hostname => qr(^$host$), - - ipv6 => sub { defined(is_ipv6($_[0])) }, - cidrv6 => sub { - my ($p, $l) = split('/', $_[0]); - return defined(is_ipv6($p)) && defined(is_between($l, 0, 128)); - }, - - # matches perl style scalar variables - # possible matches: $var ${var} $(var) - vars => qr/(? sub { return file_name_is_absolute($_[0]); }, - - # though this one does it - it stat()s if the file exists - fileexists => sub { return stat($_[0]); }, - - # do a dns lookup on given value, this also fails if - # no dns is available - so be careful with this - resolvablehost => sub { return gethostbyname($_[0]); }, - - # looks if the given value is an existing user on the host system - user => sub { return (getpwnam($_[0]))[0]; }, - - # same with group - group => sub { return getgrnam($_[0]); }, - - # int between 0 - 65535 - 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 (keys %{$self->{types}}) { - # add negative match types - $self->{types}->{'no' . $type} = $self->{types}->{$type}; - } - - return $self; -} - - -sub debug { - shift->{debug} = 1; -} - - -sub errors { - my $self = shift; - return $self->{errors}; -} - - -sub errstr { - my $self = shift; - return $self->{errors} ? $self->{errors}->[0] : ''; -} - - -sub type { - my $self = shift; - return unless @_; - - my $param = @_ > 1 ? {@_} : {%{$_[0]}}; - - foreach my $type (keys %$param) { - $self->{types}->{$type} = $param->{$type}; - # add negative match types - $self->{types}->{'no' . $type} = $param->{$type}; - } -} - - -sub validate { - my ($self, $config) = @_; - - # reset errors in case it's a repeated run - $self->{errors} = []; - - $self->_traverse($self->{structure}, $config, ()); - # return TRUE if no errors - return scalar @{ $self->{errors} } == 0; -} - -# Private methods - -sub _debug { - my ($self, $msg) = @_; - if ($self->{debug}) { - print STDERR "D::V::S::debug() - $msg\n"; - } -} - -sub _traverse { - my ($self, $reference, $hash, @tree) = @_; - - foreach my $key (keys %{$reference}) { - if (ref($reference->{$key}) eq 'ARRAY') { - - # either it is undefined (optional values) - # or it should be an array, so we can derreference it. - if (!defined($hash->{$key}) || ref($hash->{$key}) eq "ARRAY") { - - # just use the 1st one, more elements in array are expected to be the same - foreach my $item (@{$hash->{$key}}) { - if (ref($item) eq q(HASH)) { - # traverse the structure pushing our key to the @tree - $self->_traverse($reference->{$key}->[0], $item, @tree, $key); - } - else { - # a value, this is tricky - $self->_traverse( - { item => $reference->{$key}->[0] }, - { item => $item }, - @tree, $key - ); - } - } - } - else { - push @{$self->{errors}}, "$key is not an array"; - } - } - elsif (ref($reference->{$key}) eq 'HASH') { - $self->_traverse($reference->{$key}, $hash->{$key}, @tree, $key); - } - elsif (ref($reference->{$key}) eq '') { - $self->_debug("Checking $key at " . join(', ', @tree)); - if (my $err = $self->_check_type($key, $reference, $hash)) { - push @{$self->{errors}}, sprintf(q{%s at '%s'}, $err, join(' => ', @tree)); - } - } - } -} - -sub _check_type { - my ($self, $key, $reference, $hash) = @_; - - my (@types, @tmptypes, @tokens); - @types = @tmptypes = _trim( (split /\|/, $reference->{$key}) ); - # check data types - if (grep { ! exists $self->{types}->{$_} } map { s/\(.*//; $_ } @tmptypes) { - return "Invalid data type '$reference->{$key}'"; - } - - # does $key exist in $hash - unless (exists $hash->{$key}) { - # is it an optional key? - if (grep { $_ eq 'optional' } @types) { - # do nothing - $self->_debug("$key is optional"); - return; - } - else { - # report error - return "Required key '$key' is missing"; - } - } - - # the value in $hash->{$key} (shortcut) - my $value = $hash->{$key}; - - # is the value checkable? - unless (defined $value) { - if (grep { $_ eq 'optional' } @types) { - # do nothing - $self->_debug("$key is optional"); - return; - } - else { - # report error - return "value of '$key' is undef"; - } - } - - # the aggregated match over *all* types - my $match = 0; - foreach my $type (@types) { - # 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). - # we must check for both, if not we will get a false match on a type - # called 'nothing'. - my $expects = 1; - if ($type =~ /^no(.*)/) { - $expects = 0 if exists $self->{types}->{$1}; - } - - # "Evaluate" this $type. We set $result explicitly to 1 or 0 - # instead of relying the coderef returning a proper value. - # This makes comparing $expects and $result mush easier, no magic - # 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, @tokens) ? 1 : 0 - # else it's an regexp, check if it's a match - : $value =~ /$self->{types}->{$type}/ ? 1 : 0; - - $self->_debug(sprintf( - '%s = %s, value %s %s', - $key, - encode('UTF-8', $value), - $result ? 'is' : 'is not', - $type - )); - $match ||= ($expects == $result); - } - - return if $match; - - return sprintf q{'%s' doesn't match '%s'}, - encode('UTF-8', $value), $reference->{$key}; -} - - -sub _trim { - my @a = @_; - foreach (@a) { - s/^\s+|\s+$//g; - } - 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); - } - - # default, just return the name as it is - return ($type); -} - -1; - - -__END__ - -=pod - -=head1 NAME - -Data::Validate::Struct - Validate recursive Hash Structures - -=head1 SYNOPSIS - - use Data::Validate::Struct; - my $validator = new Data::Validate::Struct($reference); - if ( $validator->validate($config_hash_reference) ) { - print "valid\n"; - } - else { - print "invalid " . $validator->errstr() . "\n"; - } - -=head1 DESCRIPTION - -This module validates a config hash reference against a given hash -structure in contrast to L in which you have to -check each value separately using certain methods. - -This hash could be the result of a config parser or just any -hash structure. Eg. the hash returned by L could -be validated using this module. You may also use it to validate -CGI input, just fetch the input data from CGI, L it to a -hash and validate it. - -Data::Validate::Struct uses some of the methods exported by L, -so you need to install it too. - - -=head1 PREDEFINED BUILTIN DATA TYPES - -=over - -=item B - -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. - -=item B - -Match an octagonal value. - -=item B - -Match a decimal number, it may contain , or . and may be signed. - -=item B - -Match a single word, _ and - are tolerated. - -=item B - -Match a line of text - no newlines are allowed. - -=item B - -Match a whole text(blob) including newlines. This expression -is very loosy, consider it as an alias to B. - -=item B - -Match a perl regex using the operator qr(). Valid examples include: - - qr/[0-9]+/ - qr([^%]*) - qr{\w+(\d+?)} - -Please note, that this doesn't mean you can provide -here a regex against config options must match. - -Instead this means that the config options contains a regex. - -eg: - - $cfg = { - grp = qr/root|wheel/ - }; - -B would match the content of the variable 'grp' -in this example. - -To add your own rules for validation, use the B -method, see below. - -=item B - -Match an internet URI. - -=item B - -Match an IPv4 address. - -=item B - -The same as above including cidr netmask (/24), IPv4 only, eg: - - 10.2.123.0/23 - -Note: shortcuts are not supported for the moment, eg: - - 10.10/16 - -will fail while it is still a valid IPv4 cidr notation for -a network address (short for 10.10.0.0/16). Must be fixed -in L. - -=item B - -Match an IPv6 address. Some examples: - - 3ffe:1900:4545:3:200:f8ff:fe21:67cf - fe80:0:0:0:200:f8ff:fe21:67cf - fe80::200:f8ff:fe21:67cf - ff02:0:0:0:0:0:0:1 - ff02::1 - -=item B - -The same as above including cidr netmask (/64), IPv6 only, eg: - - 2001:db8:dead:beef::1/64 - 2001:db8::/32 - -=item B - -Match a text quoted with single quotes, eg: - - 'barbara is sexy' - -=item B - -Match a valid hostname, it must qualify to the definitions -in RFC 2396. - -=item B - -Match a hostname resolvable via dns lookup. Will fail if no -dns is available at runtime. - -=item B - -Match a valid absolute path, it won't do a stat() system call. -This will work on any operating system at runtime. So this one: - - C:\Temp - -will return TRUE if running on WIN32, but FALSE on FreeBSD! - -=item B - -Look if value is a file which exists. Does a stat() system call. - -=item B - -Looks if the given value is an existent user. Does a getpwnam() system call. - -=item B - -Looks if the given value is an existent group. Does a getgrnam() system call. - -=item B - -Match a valid tcp/udp port. Must be a digit between 0 and 65535. - -=item B - -Matches a string of text containing variables (perl style variables though) -eg: - - $user is $attribute - I am $(years) old - Missing ${points} points to succeed - -=back - - -=head1 MIXED TYPES - -If there is an element which could match more than one type, this -can be matched by using the pipe sign C<|> to separate the types. - - { name => 'int | number' } - -There is no limit on the number of types that can be checked for, and the -check is done in the sequence written (first the type 'int', and then -'number' in the example above). - - -=head1 OPTIONAL ITEMS - -If there is an element which is optional in the hash, you can use -the type 'optional' in the type. The 'optional' type can also be mixed -with ordinary types, like: - - { name => 'text | optional' } - -The type 'optional' can be placed anywhere in the type string. - - -=head1 NEGATIVE MATCHING - -In some rare situations you might require a negative match. So -a test shall return TRUE if a particular value does NOT match the -given type. This might be useful to prevent certain things. - -To achieve this, you just have to prepend one of the below mentioned -types with the keyword B. - -Example: - - $ref = { path => 'novars' } - -This returns TRUE if the value of the given config hash does NOT -contain ANY variables. - - -=head1 VALIDATOR STRUCTURE - -The expected structure must be a standard perl hash reference. -This hash may look like the config you are validating but -instead of real-live values it contains B that define -of what type a given value has to be. - -In addition the hash may be deeply nested. In this case the -validated config must be nested the same way as the reference -hash. - -Example: - - $reference = { user => 'word', uid => 'int' }; - -The following config would be validated successful: - - $config = { user => 'HansDampf', uid => 92 }; - -this one not: - - $config = { user => 'Hans Dampf', uid => 'nine' }; - ^ ^^^^ - | | - | +----- is not a number - +---------------------- space not allowed - -For easier writing of references you yould use a configuration -file parser like Config::General or Config::Any, just write the -definition using the syntax of such a module, get the hash of it -and use this hash as validation reference. - -=head1 NESTED HASH STRUCTURES - -You can also match against nested structures. B iterates -into the given config hash the same way as the reference hash looks like. - -If the config hash doesn't match the reference structure, perl will -throw an error, which B catches and returns FALSE. - -Given the following reference hash: - - $ref = { - 'b1' => { - 'b2' => { - 'b3' => { - 'item' => 'int' - } - } - } - } - -Now if you validate it against the following config hash it -will return TRUE: - - $cfg = { - 'b1' => { - 'b2' => { - 'b3' => { - 'item' => '100' - } - } - } - } - -If you validate it for example against this hash, it will -return FALSE: - - $cfg = { - 'b1' => { - 'b2' => { - 'item' => '100' - } - } - } - -=head1 SUBROUTINES/METHODS - -=over - -=item B - -$config must be a hash reference you'd like to validate. - -It returns a true value if the given structure looks valid. - -If the return value is false (0), then the error message will -be written to the variable $!. - -=item B - -You can enhance the validator by adding your own rules. Just -add one or more new types using a simple hash using the B -method. Values in this hash can be regexes or anonymous subs. - -C does accept either a hash (C<%hash>), a hash ref (C<%$hash>) or a -list of key/values (C<< key => value >>) as input. - -For details see L. - -=item B - -Enables debug output which gets printed to STDERR. - -=item B - -Returns an array ref with the errors found when validating the hash. -Each error is on the format ' doesn't match at ', -where is a comma separated tree view depicting where in the -the error occurred. - -=item B - -Returns the last error, which is useful to notify the user -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(..); - -Parameters to B are the same as of the -B method. - -For details see L. - -=head1 CUSTOM VALIDATORS - -You can add your own validators, which maybe regular expressions -or anonymous subs. Validators can be added using the B -method or globally using the B function. - -=head2 CUSTOM REGEX VALIDATORS - -If you add a validator which is just a regular expressions, -it will evaluated as is. This is the most simplest way to -customize validation. - -Sample: - - use Data::Validate::Struct qw(add_validators); - add_validators(address => qr(^\w+\s\s*\d+$)); - my $v = Data::Validate::Struct->new({place => 'address'}); - $v->validate({place => 'Livermore 19'}); - -Regexes will be executed exactly as given. No flags or ^ or $ -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. - -=head2 CUSTOM VALIDATOR FUNCTIONS - -If the validator is a coderef, it will be executed as a sub. - -Example: - - use Data::Validate::Struct qw(add_validators); - add_validators( - list => sub { - my $list = shift; - my @list = split /\s*,\s*/, $list; - return scalar @list > 1; - }, - ); - -In this example we add a new type 'list', which -is really simple. 'list' is a subroutine which gets called -during evaluation for each option which you define as type 'list'. - -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' }); - - -=head2 CUSTOM VALIDATORS USING A GRAMMAR - -Sometimes you want to be more flexible, in such cases you may -use a parser generator to validate input. This is no feature -of Data::Validate::Struct, you will just write a custom code -ref validator, which then uses the grammar. - -Here's a complete example using L: - - use Parse::RecDescent; - use Data::Validate::Struct qw(add_validators); - - my $grammar = q{ - line: expr(s) - expr: number operator number - number: int | float - int: /\d+/ - float: /\d*\\.\d+/ - operator: '+' | '-' | '*' | '/' - }; - - my $parse = Parse::RecDescent->new($grammar); - - add_validators(calc => sub { defined $parse->line($_[0]) ? 1 : 0; }); - - my $val = Data::Validate::Struct->new({line => 'calc'}); - - if ($val->validate({line => "@ARGV"})) { - my $r; - eval "\$r = @ARGV"; - print "$r\n"; - } - else { - print "syntax error\n"; - } - -Now you can use it as follows: - - ./mycalc 54 + 100 - .1 - 153.9 - - ./mycalc 8^2 - syntax error - -=head2 NEGATED VALIDATOR - -A negative/reverse match is automatically added as well, see -L. - -=head1 EXAMPLES - -Take a look to F for lots of examples. - -=head1 CONFIGURATION AND ENVIRONMENT - -No environment variables will be used. - -=head1 SEE ALSO - -I recommend you to read the following documentations, which are supplied with perl: - -L Perl references short introduction. - -L Perl references, the rest of the story. - -L Perl data structures intro. - -L Perl data structures: arrays of arrays. - -L common data validation methods. - -L common data validation methods for IP-addresses. - -=head1 LICENSE AND COPYRIGHT - -Copyright (c) 2007-2015 T. v.Dein - -This library is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -=head1 BUGS AND LIMITATIONS - -Some implementation details as well as the API may change -in the future. This will no more happen if entering a stable -release (starting with 1.00). - -To submit use L. - -=head1 INCOMPATIBILITIES - -None known. - -=head1 DIAGNOSTICS - -To debug Data::Validate::Struct use B or the perl debugger, see L. - -For example to debug the regex matching during processing try this: - - perl -Mre=debug yourscript.pl - -=head1 DEPENDENCIES - -Data::Validate::Struct depends on the module L, -L, L, L and L. - -=head1 AUTHORS - -T. v.Dein - -Per Carlson - -Thanks to David Cantrell for his helpful hints. - -=head1 VERSION - -0.11 - -=cut - diff --git a/cpanfile b/cpanfile deleted file mode 100644 index 917e4a9..0000000 --- a/cpanfile +++ /dev/null @@ -1,8 +0,0 @@ -# -*-perl-*- -requires 'Regexp::Common'; -requires 'Data::Validate', '0.06'; -requires 'Data::Validate::IP', '0.18'; - -on test => sub { - requires 'Test::More'; -}; diff --git a/t/run.t b/t/run.t deleted file mode 100644 index 9354c7f..0000000 --- a/t/run.t +++ /dev/null @@ -1,441 +0,0 @@ -# -*-perl-*- -use utf8; -use Test::More; -use Encode qw{ encode }; - -require_ok( 'Data::Validate::Struct' ); - -my $ref = { - 'b1' => { - 'b2' => { - 'b3' => { - 'item' => 'int' - } - } - }, - 'item' => [ 'number' ], - 'v1' => 'int', - 'v2' => 'number', - 'v3' => 'word', - 'v4' => 'line', - 'v5' => 'text', - 'v6' => 'hostname', - 'v8' => 'user', - 'v10' => 'port', - 'v11' => 'uri', - 'v12' => 'cidrv4', - 'v13' => 'ipv4', - 'v14' => 'path', - 'v15' => 'fileexists', - 'v16' => 'quoted', - 'v171' => 'regex', - 'v172' => 'regex', - 'v18' => 'novars', - 'v19' => 'ipv6', - 'v20' => 'ipv6', - 'v21' => 'ipv6', - 'v22' => 'ipv6', - 'v23' => 'ipv6', - 'v24' => 'ipv6', - 'v25' => 'ipv6', - 'v26' => 'cidrv6', - - 'v27' => 'int | vars', - 'v28' => 'int | vars', - - 'o1' => 'int | optional', - - 'AoA' => [ [ 'int' ] ], - - 'AoH' => [ - { - fullname => 'text', user => 'word', uid => 'int' } - ], - - 'HoH' => { - father => { fullname => 'text', user => 'word' }, - son => { fullname => 'text', user => 'word' }, - daughter => { fullname => 'text', user => 'word' }, - }, - - 'r1' => 'range(80-90)', - }; - -my $cfg = { - 'b1' => { - 'b2' => { - 'b3' => { - 'item' => '100' - } - } - }, - 'item' => [ - '10', - '20', - '30' - ], - 'v1' => '123', - 'v2' => '19.03', - 'v3' => 'Johannes', - 'v4' => 'this is a line of text', - 'v5' => 'This is a text block - This is a text block', - 'v6' => 'search.cpan.org', - 'v8' => 'root', - 'v10' => '22', - 'v11' => 'http://search.cpan.org/~tlinden/?ignore¬=1', - 'v12' => '192.168.1.101/18', - 'v13' => '10.0.0.193', - 'v14' => '/etc/ssh/sshd.conf', - 'v15' => 'MANIFEST', - 'v16' => '\' this is a quoted string \'', - 'v171' => qr([0-9]+), - 'v172' => 'qr([0-9]+)', - 'v18' => 'Doesnt contain any variables', - 'v19' => '3ffe:1900:4545:3:200:f8ff:fe21:67cf', - 'v20' => 'fe80:0:0:0:200:f8ff:fe21:67cf', - 'v21' => 'fe80::200:f8ff:fe21:67cf', - 'v22' => 'ff02:0:0:0:0:0:0:1', - 'v23' => 'ff02::1', - 'v24' => '::ffff:192.0.2.128', - 'v25' => '::', - 'v26' => '2001:db8:dead:beef::b00c/64', - - 'v27' => '10', - 'v28' => '$ten', - - 'AoA' => [ - [ qw{ 10 11 12 13 } ], - [ qw{ 20 21 22 23 } ], - [ qw{ 30 31 32 33 } ], - ], - - 'AoH' => [ - { - fullname => 'Homer Simpson', user => 'homer', uid => 100 }, - { - fullname => 'Bart Simpson', user => 'bart', uid => 101 }, - { - fullname => 'Lisa Simpson', user => 'lisa', uid => 102 }, - ], - - 'HoH' => { - father => { fullname => 'Homer Simpson', user => 'homer' }, - son => { fullname => 'Bart Simpson', user => 'bart' }, - daughter => { fullname => 'Lisa Simpson', user => 'lisa' }, - }, - - 'r1' => 85, - }; - -my $v = new_ok('Data::Validate::Struct', [ $ref ]); -ok ($v->validate($cfg), "validate a reference against a OK config"); - - -# check failure matching -my @failure = ( - { - cfg => q(acht), - type => q(int), - descr => 'int', - errors => 1, - }, - - { - cfg => q(27^8), - type => q(number), - descr => 'number', - errors => 1, - }, - - { - cfg => q(two words), - type => q(word), - descr => 'word', - errors => 1, - }, - - { - cfg => qq(< q(line), - descr => 'line', - errors => 1, - }, - - { - cfg => q(ätz), - type => q(hostname), - descr => 'hostname', - errors => 1, - }, - - { - cfg => q(gibtsnet123456790.intern), - type => q(resolvablehost), - descr => 'resolvablehost', - errors => 1, - }, - - { - cfg => q(äüö), - type => q(user), - descr => 'user', - errors => 1, - }, - - { - cfg => q(äüö), - type => q(group), - descr => 'group', - errors => 1, - }, - - { - cfg => q(234234444), - type => q(port), - descr => 'port', - errors => 1, - }, - - { - cfg => q(unknown:/unsinnüäö), - type => q(uri), - descr => 'uri', - errors => 1, - }, - - { - cfg => q(1.1.1.1/33), - type => q(cidrv4), - descr => 'cidrv4', - errors => 1, - }, - - { - cfg => q(300.1.1.1), - type => q(ipv4), - descr => 'ipv4', - errors => 1, - }, - - { - cfg => q(üäö), - type => q(fileexists), - descr => 'fileexists', - errors => 1, - }, - - { - cfg => q(not quoted), - type => q(quoted), - descr => 'quoted', - errors => 1, - }, - - { - cfg => q(no regex), - type => q(regex), - descr => 'regex', - errors => 1, - }, - - { - cfg => q($contains some $vars), - type => q(novars), - descr => 'novars', - errors => 1, - }, - - { - cfg => q(2001:db8::dead::beef), - type => q(ipv6), - descr => 'ipv6', - errors => 1, - }, - - { - cfg => q(2001:db8:dead:beef::1/129), - type => q(cidrv6), - descr => 'cidrv6', - errors => 1, - }, - - { - cfg => [ - [ qw{ 10 11 12 13 } ], - [ qw{ 'twenty' 21 22 23 } ], - [ qw{ 30 31 32.0 33 } ], - ], - - type => [ [ 'int' ] ], - - descr => 'array of arrays', - errors => 2, - }, - - { - cfg => [ - { - fullname => 'Homer Simpson', user => 'homer', uid => 100 }, - { - fullname => 'Bart Simpson', user => ':bart', uid => 101 }, - { - fullname => 'Lisa Simpson', user => 'lisa', uid => '102' }, - ], - - type => [ - { - fullname => 'text', user => 'word', uid => 'int' } - ], - - descr => 'array of hashes', - errors => 1, - }, - - { - cfg => { - father => { fullname => 'Homer Simpson', user => 'homer', uid => 100 }, - son => { fullname => 'Bart Simpson', user => 'bart', uid => 'one hundred one' }, - daughter => { fullname => 'Lisa Simpson', user => 'lisa:', uid => 'one hundred two' }, - }, - - type => { - father => { fullname => 'text', user => 'word', uid => 'int' }, - son => { fullname => 'text', user => 'word', uid => 'int' }, - daughter => { fullname => 'text', user => 'word', uid => 'int' }, - }, - - descr => 'hash of hashes', - errors => 3, - }, - - { - cfg => { - name => 'Foo Bar', - age => 42, - }, - - type => { - name => 'text', - age => 'int', - address => 'text', - }, - - descr => 'Missing required field', - 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 = Data::Validate::Struct->new($ref); - #$v->debug(); - my $result = $v->validate($cfg); - my $descr = encode('UTF-8', - exists $test->{descr} ? $test->{descr} : $test->{cfg} - ); - my $errors = exists $test->{errors} ? $test->{errors} : 1; - unless ($result) { - is @{$v->errors}, $errors, "Caught failure for '$descr'"; - } else { - fail("Couldn't catch invalid '$test->{descr}'"); - } -} - - -# clean old object -undef $v; -$v = Data::Validate::Struct->new({ - h1 => { h2 => { item => 'int' } } - }); -ok !$v->validate({ - h1 => { h2 => { item => 'qux' } } - }), 'item is not an h1 => h2 => int'; -is $v->errstr, q{'qux' doesn't match 'int' at 'h1 => h2'}, 'correct error trace'; - - -# adding custom type -my $ref3 = { - v1 => 'address', - v2 => 'list', - v3 => 'noob', - v4 => 'nonoob', - }; -my $cfg3 = { - v1 => 'Marblestreet 15', - v2 => 'a1, b2, b3', - v3 => 42, - v4 => 43, - }; - -my $v3 = new Data::Validate::Struct($ref3); -# add via hash -note('added via hash'); -my %h = ( - address => qr(^\w+\s\s*\d+$) - ); -$v3->type(%h); - -# add via hash ref -note('added via hash ref'); -$v3->type({ list => - sub { - my $list = $_[0]; - my @list = split /\s*,\s*/, $list; - return scalar @list > 1; - } - }); - -# add via key => value -note('added via key => val'); -$v3->type(noob => sub { return $_[0] == 42 }); - -ok($v3->validate($cfg3), "using custom types"); - - -# check if errors are not cached -my $v4 = Data::Validate::Struct->new({age => 'int'}); -ok(!$v4->validate({age => 'eight'}), "cache check first run, error"); -ok($v4->validate({age => 8}), "cache check second run, no error"); - -# optional array, see: -# https://codeberg.org/scip/Data-Validate-Struct/issues/7 -my $ref5 = { - routers => [ { - stubs => [ { - network => 'ipv4', - }, {} ], - }, {}, ], - }; -my $test5 = { - 'routers' => [ - { - 'stubs' => [ - { - 'network' => '172.31.199.0', - } - ], - 'router' => '172.31.199.2', # optional, ignored by validate - }, - { # optional as well - 'router' => '172.30.5.5', - }, - ], - }; -my $v5 = Data::Validate::Struct->new($ref5); -ok($v5->validate($test5), "check optional " . $Data::Validate::Struct::VERSION); - -# different references -my $v6 = Data::Validate::Struct->new({ foo => [{bar => 'int'}]}); -ok(!$v6->validate({foo=>{bar=>10}})); - -done_testing();