scip/Data-Validate-Struct
1
0
Fork 0
mirror of https://codeberg.org/scip/Data-Validate-Struct.git synced 2025-12-17 20:51:01 +01:00
Code Issues Packages Projects Releases Wiki Activity

bump version, <tab> => spc

Browse Source
This commit is contained in:
git@daemon.de
2016-06-02 13:35:50 +02:00
parent 8ee3ea673c
commit f407cf9737
3 changed files with 83 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
Changelog
View File

@@ -1,3 +1,8 @@
0.11
o typos
o added cpanfile
0.10 0.10
o fixed RT#101884 o fixed RT#101884
- _trim() only removed 1st whitespace - _trim() only removed 1st whitespace

30
Makefile.PL
View File

@@ -1,7 +1,7 @@
# #
# Makefile.PL - build file for Date::Validate::Struct # Makefile.PL - build file for Date::Validate::Struct
# #
# Copyright (c) 2007-2014 T. v.Dein <tom |AT| cpan.org>. # Copyright (c) 2007-2016 T. v.Dein <tom |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies. # All Rights Reserved. Std. disclaimer applies.
# Artistic License, same as perl itself. Have fun. # Artistic License, same as perl itself. Have fun.
# #
@@ -9,27 +9,27 @@
use ExtUtils::MakeMaker; use ExtUtils::MakeMaker;
WriteMakefile( WriteMakefile(
NAME => 'Data::Validate::Struct', NAME => 'Data::Validate::Struct',
VERSION_FROM => 'Struct.pm', VERSION_FROM => 'Struct.pm',
ABSTRACT => 'Validate recursive hash structures', ABSTRACT => 'Validate recursive hash structures',
LICENSE => 'perl', LICENSE => 'perl',
AUTHOR => [ AUTHOR => [
'Thomas v.Dein <tom@cpan.org>', 'Thomas v.Dein <tom@cpan.org>',
'Per Carlson <pelle@cpan.org>', 'Per Carlson <pelle@cpan.org>',
], ],
clean => { FILES => '*~ */*~' }, clean => { FILES => '*~ */*~' },
PREREQ_PM => { PREREQ_PM => {
'Regexp::Common' => 0, 'Regexp::Common' => 0,
'Data::Validate' => '0.06', 'Data::Validate' => '0.06',
'Data::Validate::IP' => '0.18', 'Data::Validate::IP' => '0.18',
}, },
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
test => { TESTS => 't/*.t' }, test => { TESTS => 't/*.t' },
'META_MERGE' => { 'META_MERGE' => {
resources => { resources => {
repository => 'https://github.com/TLINDEN/Data-Validate-Struct', repository => 'https://github.com/TLINDEN/Data-Validate-Struct',
}, },
}, },
); );

126
Struct.pm
View File

@@ -1,5 +1,5 @@
# #
# Copyright (c) 2007-2015 T. v.Dein <tlinden |AT| cpan.org>. # Copyright (c) 2007-2016 T. v.Dein <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies. # All Rights Reserved. Std. disclaimer applies.
# Artistic License, same as perl itself. Have fun. # Artistic License, same as perl itself. Have fun.
# #
@@ -21,7 +21,7 @@ use File::stat;
use Data::Validate qw(:math is_printable); use Data::Validate qw(:math is_printable);
use Data::Validate::IP qw(is_ipv4 is_ipv6); use Data::Validate::IP qw(is_ipv4 is_ipv6);
our $VERSION = 0.10; our $VERSION = 0.11;
use vars qw(@ISA); use vars qw(@ISA);
@@ -32,81 +32,81 @@ require Exporter;
@EXPORT_OK = qw(add_validators); @EXPORT_OK = qw(add_validators);
%__ValidatorTypes = ( %__ValidatorTypes = (
# primitives # primitives
int => sub { return defined(is_integer($_[0])); }, int => sub { return defined(is_integer($_[0])); },
hex => sub { return defined(is_hex($_[0])); }, hex => sub { return defined(is_hex($_[0])); },
oct => sub { return defined(is_oct($_[0])); }, oct => sub { return defined(is_oct($_[0])); },
number => sub { return defined(is_numeric($_[0])); }, number => sub { return defined(is_numeric($_[0])); },
word => qr(^[\w_\-]+$), word => qr(^[\w_\-]+$),
line => qr/^[^\n]+$/s, line => qr/^[^\n]+$/s,
text => sub { return defined(is_printable($_[0])); }, text => sub { return defined(is_printable($_[0])); },
regex => sub { regex => sub {
my $r = ref $_[0]; my $r = ref $_[0];
return 1 if $r eq 'Regexp'; return 1 if $r eq 'Regexp';
if ($r eq '') { if ($r eq '') {
# this is a bit loosy but should match most regular expressions # this is a bit loosy but should match most regular expressions
# using the qr() operator, but it doesn't check if the expression # 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 # is valid. we could do this by compiling it, but this would lead
# to exploitation possiblities to programs using the module. # to exploitation possiblities to programs using the module.
return $_[0] =~ qr/^qr ( (.).*\1 | \(.*\) | \{.*\} ) $/x; return $_[0] =~ qr/^qr ( (.).*\1 | \(.*\) | \{.*\} ) $/x;
} }
return 0; return 0;
}, },
# via imported regexes # via imported regexes
uri => qr(^$RE{URI}$), uri => qr(^$RE{URI}$),
cidrv4 => sub { cidrv4 => sub {
my ($p, $l) = split(/\//, $_[0]); my ($p, $l) = split(/\//, $_[0]);
return defined(is_ipv4($p)) && defined(is_between($l, 0, 32)); return defined(is_ipv4($p)) && defined(is_between($l, 0, 32));
}, },
ipv4 => sub { defined(is_ipv4($_[0])) }, ipv4 => sub { defined(is_ipv4($_[0])) },
quoted => qr/^$RE{delimited}{ -delim => qr(\') }$/, quoted => qr/^$RE{delimited}{ -delim => qr(\') }$/,
hostname => qr(^$host$), hostname => qr(^$host$),
ipv6 => sub { defined(is_ipv6($_[0])) }, ipv6 => sub { defined(is_ipv6($_[0])) },
cidrv6 => sub { cidrv6 => sub {
my ($p, $l) = split('/', $_[0]); my ($p, $l) = split('/', $_[0]);
return defined(is_ipv6($p)) && defined(is_between($l, 0, 128)); return defined(is_ipv6($p)) && defined(is_between($l, 0, 128));
}, },
# matches perl style scalar variables # matches perl style scalar variables
# possible matches: $var ${var} $(var) # possible matches: $var ${var} $(var)
vars => qr/(?<!\\) ( \$\w+ | \$\{[^\}]+\} | \$\([^\)]+\) )/x, vars => qr/(?<!\\) ( \$\w+ | \$\{[^\}]+\} | \$\([^\)]+\) )/x,
# closures # closures
# this one doesn't do a stat() syscall, so keep cool # this one doesn't do a stat() syscall, so keep cool
path => sub { return file_name_is_absolute($_[0]); }, path => sub { return file_name_is_absolute($_[0]); },
# though this one does it - it stat()s if the file exists # though this one does it - it stat()s if the file exists
fileexists => sub { return stat($_[0]); }, fileexists => sub { return stat($_[0]); },
# do a dns lookup on given value, this also fails if # do a dns lookup on given value, this also fails if
# no dns is available - so be careful with this # no dns is available - so be careful with this
resolvablehost => sub { return gethostbyname($_[0]); }, resolvablehost => sub { return gethostbyname($_[0]); },
# looks if the given value is an existing user on the host system # looks if the given value is an existing user on the host system
user => sub { return (getpwnam($_[0]))[0]; }, user => sub { return (getpwnam($_[0]))[0]; },
# same with group # same with group
group => sub { return getgrnam($_[0]); }, group => sub { return getgrnam($_[0]); },
# int between 0 - 65535 # int between 0 - 65535
port => sub { port => sub {
if ( $_[0] =~ /^$port$/ && ($_[0] > 0 && $_[0] < 65535) ) if ( $_[0] =~ /^$port$/ && ($_[0] > 0 && $_[0] < 65535) )
{ return 1; } else { return 0; } }, { return 1; } else { return 0; } },
# variable integer range, use: range(N1 - N2) # variable integer range, use: range(N1 - N2)
range => sub { range => sub {
if ( defined(is_integer($_[0])) && ($_[0] >= $_[2] && $_[0] <= $_[3]) ) if ( defined(is_integer($_[0])) && ($_[0] >= $_[2] && $_[0] <= $_[3]) )
{ return 1; } else { return 0; } }, { return 1; } else { return 0; } },
# just a place holder at make the key exist # just a place holder at make the key exist
optional => 1, optional => 1,
); );
sub add_validators { sub add_validators {
# class method, add validators globally, not per object # class method, add validators globally, not per object
@@ -899,7 +899,7 @@ Thanks to David Cantrell for his helpful hints.
=head1 VERSION =head1 VERSION
0.10 0.11
=cut =cut