no 5.22

.woodpecker/build.yaml

@@ -0,0 +1,22 @@
+matrix:
+  include:
+    - 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

.woodpecker/release.sh

@@ -0,0 +1,54 @@
+#!/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

.woodpecker/release.yaml

@@ -0,0 +1,23 @@
+# 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

Changelog

@@ -0,0 +1,98 @@
+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

MANIFEST

@@ -0,0 +1,7 @@
+MANIFEST
+Makefile.PL
+Struct.pm
+README
+Changelog
+META.yml                                 Module meta-data (added by MakeMaker)
+META.json                                 Module meta-data (added by MakeMaker)

META.json

@@ -0,0 +1,49 @@
+{
+   "abstract" : "Validate recursive hash structures",
+   "author" : [
+      "Thomas v.Dein <tom@cpan.org>",
+      "Per Carlson <pelle@cpan.org>"
+   ],
+   "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,
+}

META.yml

@@ -0,0 +1,27 @@
+---
+abstract: 'Validate recursive hash structures'
+author:
+  - 'Thomas v.Dein <tom@cpan.org>'
+  - 'Per Carlson <pelle@cpan.org>'
+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

Makefile.PL

@@ -0,0 +1,35 @@
+#
+# Makefile.PL - build file for Date::Validate::Struct
+#
+# Copyright (c) 2007-2016 T. v.Dein <tom |AT| cpan.org>.
+# 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 <tom@cpan.org>',
+                               'Per Carlson <pelle@cpan.org>',
+                              ],
+              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',
+                                            },
+                              },
+
+             );
+

README.md

@@ -2,9 +2,6 @@
 
 # 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;

Struct.pm

@@ -0,0 +1,914 @@
+#
+# Copyright (c) 2007-2016 T. v.Dein <tlinden |AT| cpan.org>.
+# 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/(?<!\\) ( \$\w+ | \$\{[^\}]+\} | \$\([^\)]+\) )/x,
+
+                     # closures
+
+                     # this one doesn't do a stat() syscall, so keep cool
+                     path           => 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<Data::Validate> 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<XML::Simple> could
+be validated using this module. You may also use it to validate
+CGI input, just fetch the input data from CGI, L<map> it to a
+hash and validate it.
+
+Data::Validate::Struct uses some of the methods exported by L<Data::Validate>,
+so you need to install it too.
+
+
+=head1 PREDEFINED BUILTIN DATA TYPES
+
+=over
+
+=item B<int>
+
+Match a simple integer number.
+
+=item B<range(a-b)>
+
+Match a simple integer number in a range between a and b. Eg:
+
+ { loginport => 'range(22-23)' }
+
+=item B<hex>
+
+Match a hex value.
+
+=item B<oct>
+
+Match an octagonal value.
+
+=item B<number>
+
+Match a decimal number, it may contain , or . and may be signed.
+
+=item B<word>
+
+Match a single word, _ and - are tolerated.
+
+=item B<line>
+
+Match a line of text - no newlines are allowed.
+
+=item B<text>
+
+Match a whole text(blob) including newlines. This expression
+is very loosy, consider it as an alias to B<any>.
+
+=item B<regex>
+
+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<regex> would match the content of the variable 'grp'
+in this example.
+
+To add your own rules for validation, use the B<type()>
+method, see below.
+
+=item B<uri>
+
+Match an internet URI.
+
+=item B<ipv4>
+
+Match an IPv4 address.
+
+=item B<cidrv4>
+
+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<Regex::Common>.
+
+=item B<ipv6>
+
+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<cidrv6>
+
+The same as above including cidr netmask (/64), IPv6 only, eg:
+
+  2001:db8:dead:beef::1/64
+  2001:db8::/32
+
+=item B<quoted>
+
+Match a text quoted with single quotes, eg:
+
+  'barbara is sexy'
+
+=item B<hostname>
+
+Match a valid hostname, it must qualify to the definitions
+in RFC 2396.
+
+=item B<resolvablehost>
+
+Match a hostname resolvable via dns lookup. Will fail if no
+dns is available at runtime.
+
+=item B<path>
+
+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<fileexists>
+
+Look if value is a file which exists. Does a stat() system call.
+
+=item B<user>
+
+Looks if the given value is an existent user. Does a getpwnam() system call.
+
+=item B<group>
+
+Looks if the given value is an existent group. Does a getgrnam() system call.
+
+=item B<port>
+
+Match a valid tcp/udp port. Must be a digit between 0 and 65535.
+
+=item B<vars>
+
+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<no>.
+
+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<types> 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<Data::Validate::Struct> 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<Data::Validate::Struct> 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<validate($config)>
+
+$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<type(%types)>
+
+You can enhance the validator by adding your own rules. Just
+add one or more new types using a simple hash using the B<type()>
+method. Values in this hash can be regexes or anonymous subs.
+
+C<type> 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<CUSTOM VALIDATORS>.
+
+=item B<debug()>
+
+Enables debug output which gets printed to STDERR.
+
+=item B<errors>
+
+Returns an array ref with the errors found when validating the hash.
+Each error is on the format '<value> doesn't match <types> at <ref>',
+where <ref> is a comma separated tree view depicting where in the
+the error occurred.
+
+=item B<errstr()>
+
+Returns the last error, which is useful to notify the user
+about what happened. The format is like in L</errors>.
+
+=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<add_validators> are the same as of the
+B<type> method.
+
+For details see L<CUSTOM VALIDATORS>.
+
+=head1 CUSTOM VALIDATORS
+
+You can add your own validators, which maybe regular expressions
+or anonymous subs. Validators can be added using the B<type()>
+method or globally using the B<add_validators()> 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<Parse::RecDescent>:
+
+ 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</NEGATIVE MATCHING>.
+
+=head1 EXAMPLES
+
+Take a look to F<t/run.t> 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<perlreftut> Perl references short introduction.
+
+L<perlref> Perl references, the rest of the story.
+
+L<perldsc> Perl data structures intro.
+
+L<perllol> Perl data structures: arrays of arrays.
+
+L<Data::Validate> common data validation methods.
+
+L<Data::Validate::IP> 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<http://rt.cpan.org>.
+
+=head1 INCOMPATIBILITIES
+
+None known.
+
+=head1 DIAGNOSTICS
+
+To debug Data::Validate::Struct use B<debug()> or the perl debugger, see L<perldebug>.
+
+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<Data::Validate>,
+L<Data::Validate:IP>, L<Regexp::Common>, L<File::Spec> and L<File::stat>.
+
+=head1 AUTHORS
+
+T. v.Dein <tlinden |AT| cpan.org>
+
+Per Carlson <pelle |AT| cpan.org>
+
+Thanks to David Cantrell for his helpful hints.
+
+=head1 VERSION
+
+0.11
+
+=cut
+

cpanfile

@@ -0,0 +1,8 @@
+# -*-perl-*-
+requires 'Regexp::Common';
+requires 'Data::Validate', '0.06';
+requires 'Data::Validate::IP', '0.18';
+
+on test => sub {
+  requires 'Test::More';
+};

t/run.t

@@ -0,0 +1,441 @@
+# -*-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&not=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(<<EOF\nzeile1\nzeile2\nzeile3\nEOF\n),
+                type => 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();