Modified: perl/embperl/trunk/Embperl/Form/Validate.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate.pm Sun Oct 1 13:06:43 2023 @@ -258,16 +258,14 @@ sub newtype sub validate_rules { - my ($self, $frules, $fdat, $pref, $result) = @_ ; + my ($self, $frules, $fdat, $pref, $result, $key, $name) = @_ ; my %param ; my $type ; my $typeobj ; my $i ; my $keys = [] ; - my $key ; my $status ; - my $name ; my $msg ; my $break = 0 ; my @key_stack ; @@ -277,7 +275,7 @@ sub validate_rules my $action = $frules -> [$i++] ; if (ref $action eq 'ARRAY') { - my $fail = $self -> validate_rules ($action, $fdat, $pref, $result) ; + my $fail = $self -> validate_rules ($action, $fdat, $pref, $result, $key, $name) ; return $fail if ($fail) ; } elsif (ref $action eq 'CODE') @@ -294,7 +292,7 @@ sub validate_rules if ($1 eq 'key') { $key = $frules->[$i++] ; - $keys = ref $key?$key:[$key] ; + $keys = ref $key?$key:[$key] ; $type = 'Default' ; $typeobj = $self -> newtype ($type) ; $name = undef ; @@ -302,17 +300,26 @@ sub validate_rules } elsif ($1 eq 'key_check') { - push @key_stack, $key ; + push @key_stack, $key ; $key = $frules->[$i++] ; - $keys = ref $key?$key:[$key] ; + $keys = ref $key?$key:[$key] ; $type = 'Default' ; $typeobj = $self -> newtype ($type) ; - $break = 1 ; + $break = 1 ; } elsif ($1 eq 'key_end') { - $key = pop @key_stack ; - $break = 0 ; + $key = pop @key_stack ; + $keys = ref $key?$key:[$key] ; + $break = 0 ; + } + elsif ($1 eq 'frontend_only') + { + last ; + } + elsif ($1 eq 'backend_only') + { + ; } elsif ($1 eq 'name') { @@ -330,11 +337,11 @@ sub validate_rules { $type = $frules->[$i++] ; $typeobj = $self -> newtype ($type) ; - foreach my $k (@$keys) - { - $status = $typeobj -> validate ($k, $fdat -> {$k}, $fdat, $pref) ; - last if (!$status) ; - } + foreach my $k (@$keys) + { + $status = $typeobj -> validate ($k, $fdat -> {$k}, $fdat, $pref) ; + last if (!$status) ; + } } else { @@ -346,7 +353,7 @@ sub validate_rules my $arg = $frules -> [$i++] ; foreach my $k (@$keys) { - my $method = 'validate_' . $action ; + my $method = 'validate_' . $action ; $status = $typeobj -> $method ($k, $fdat -> {$k}, $arg, $fdat, $pref) ; last if (!$status) ; } @@ -390,8 +397,22 @@ sub build_message my $default_language = $pref -> {default_language} || $self -> {default_language} ; my $charset = $pref -> {charset} ; my $txt ; - - $name ||= $epreq?$epreq -> gettext($key):$key ; + if ($name eq '') + { + if (!ref $key) + { + $name = $epreq?$epreq -> gettext('attr:' . $key):$key ; + } + else + { + my @name ; + foreach my $k (@$key) + { + push @name, $epreq?$epreq -> gettext('attr:' . $k):$k ; + } + $name = join (($language =~ /^de/)?' oder ':' or ', @name) ; + } + } if (ref $name eq 'ARRAY') { my @names ; @@ -409,6 +430,7 @@ sub build_message if ($msg) { $txt = ref $msg ? ($msg -> {"$language.$charset"} || $msg -> {"$default_language.$charset"} || $msg -> {$language} || $msg -> {$default_language} || (each %$msg)[1] || undef):$msg ; + $txt = $epreq -> gettext ($msg) if ($epreq && ($msg =~ /^\w\w\w:/)) ; } else { @@ -506,16 +528,14 @@ sub validate_messages sub gather_script_code { - my ($self, $frules, $pref, $epreq) = @_ ; + my ($self, $frules, $pref, $epreq, $key, $name) = @_ ; my %param ; my $type ; my $typeobj ; my $i ; my $keys = [] ; - my $key ; my $status ; - my $name ; my $msg ; my $msgparam ; my $language = $pref -> {language} ; @@ -533,7 +553,7 @@ sub gather_script_code my $action = $frules -> [$i++] ; if (ref $action eq 'ARRAY') { - $script .= $self -> gather_script_code ($action, $pref, $epreq) ; + $script .= $self -> gather_script_code ($action, $pref, $epreq, $key, $name) ; } elsif (ref $action eq 'CODE') { @@ -544,7 +564,7 @@ sub gather_script_code if ($1 eq 'key') { $key = $frules->[$i++] ; - $keys = ref $key?$key:[$key] ; + $keys = ref $key?$key:[$key] ; $type = 'Default' ; $typeobj = $self -> newtype ($type) ; $name = undef ; @@ -552,17 +572,25 @@ sub gather_script_code } elsif ($1 eq 'key_check') { - push @key_stack, $key ; + push @key_stack, $key ; $key = $frules->[$i++] ; - $keys = ref $key?$key:[$key] ; + $keys = ref $key?$key:[$key] ; $type = 'Default' ; $typeobj = $self -> newtype ($type) ; - $break = 1 ; + $break = 1 ; } elsif ($1 eq 'key_end') { - $key = pop @key_stack ; - $break = 0 ; + $key = pop @key_stack ; + $break = 0 ; + } + elsif ($1 eq 'frontend_only') + { + ; + } + elsif ($1 eq 'backend_only') + { + last ; } elsif ($1 eq 'name') { @@ -590,7 +618,7 @@ sub gather_script_code } else { - $method = 'getscript_' . $action ; + $method = 'getscript_' . $action ; $arg = $frules -> [$i++] ; } @@ -932,6 +960,26 @@ errors only break current block, but doe The above example will only require the field "input", when the field "action" is not empty and is not zero. +=item -key_check, -key_end + +Is used for preconditions, same example as for -break + + [ + -key => 'input', + -key_check => 'action', emptyok => 1, ne => 0, -key_end, + 'required' => 1 + ] + +The above example will only require the field "input", when the field "action" is +not empty and is not zero. + +=item backend_only + +The following rules will only executed in the backend + +=item frontend_only + +The following rules will only executed in the fronend =item [arrayref]
Modified: perl/embperl/trunk/Embperl/Form/Validate/DateTime.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/DateTime.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/DateTime.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/DateTime.pm Sun Oct 1 13:06:43 2023 @@ -17,12 +17,13 @@ package Embperl::Form::Validate::DateTime ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; my %error_messages = ( de => { - validate_datetime_eu => 'Feld %0: "%1" ist kein g𬴩ges Zeitformat. Geben Sie die Zeit in der Form tt.mm.jjjj hh:mm:ss ein. Die Angabe der Zeit nach dem Datum ist optional.', + validate_datetime_eu => 'Feld %0: "%1" ist kein gültiges Zeitformat. Geben Sie die Zeit in der Form tt.mm.jjjj hh:mm:ss ein. Die Angabe der Zeit nach dem Datum ist optional.', }, 'de.utf-8' => @@ -56,12 +57,12 @@ sub validate if($value =~ /^(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(.)$/) { - if ($4 < 1 || $4 > 31 || - $5 < 1 || $5 > 12 || - $6 < 1900 || $6 > 2100 || - $3 < 0 || $3 > 23 || - $4 < 0 || $4 > 59 || - $5 < 0 || $5 > 59) + if ($3 < 1 || $3 > 31 || + $2 < 1 || $2 > 12 || + $1 < 1900 || $1 > 2100 || + $4 < 0 || $4 > 23 || + $5 < 0 || $5 > 59 || + $6 < 0 || $6 > 59) { return ['validate_datetime_eu', $value] ; } Modified: perl/embperl/trunk/Embperl/Form/Validate/DateTimeEU.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/DateTimeEU.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/DateTimeEU.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/DateTimeEU.pm Sun Oct 1 13:06:43 2023 @@ -1,44 +1,45 @@ - -################################################################################### -# -# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de -# Embperl - Copyright (c) 2008-2014 Gerald Richter -# -# You may distribute under the terms of either the GNU General Public -# License or the Artistic License, as specified in the Perl README file. -# -# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR -# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. -# -################################################################################### - - -package Embperl::Form::Validate::DateTimeEU ; - -use base qw(Embperl::Form::Validate::DateTime); - - -# -------------------------------------------------------------- - -sub validate - { - my ($self, $key, $value, $fdat, $pref) = @_ ; - - if($value =~ /^(\d{1:2})\.(\d{1:2})\.(\d{1:4})\s+(\d{1:2})\.(\d{1:2})\.(\d{1:4})$/) - { - if ($1 < 1 || $1 > 31 || - $2 < 1 || $2 > 12 || - $3 < 1900 || $3 > 2100 || - $4 < 0 || $4 > 23 || - $5 < 0 || $5 > 59 || - $6 < 0 || $6 > 59) - { - return ['validate_datetime_eu', $value] ; - } - return undef ; - } - - - -1; + +################################################################################### +# +# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de +# Embperl - Copyright (c) 2008-2014 Gerald Richter +# +# You may distribute under the terms of either the GNU General Public +# License or the Artistic License, as specified in the Perl README file. +# +# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. +# +################################################################################### + + +package Embperl::Form::Validate::DateTimeEU ; + +use base qw(Embperl::Form::Validate::DateTime); +use utf8 ; + + +# -------------------------------------------------------------- + +sub validate + { + my ($self, $key, $value, $fdat, $pref) = @_ ; + + if($value =~ /^(\d{1:2})\.(\d{1:2})\.(\d{1:4})\s+(\d{1:2})\.(\d{1:2})\.(\d{1:4})$/) + { + if ($1 < 1 || $1 > 31 || + $2 < 1 || $2 > 12 || + $3 < 1900 || $3 > 2100 || + $4 < 0 || $4 > 23 || + $5 < 0 || $5 > 59 || + $6 < 0 || $6 > 59) + { + return ['validate_datetime_eu', $value] ; + } + return undef ; + } + + + +1; Modified: perl/embperl/trunk/Embperl/Form/Validate/Default.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/Default.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/Default.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/Default.pm Sun Oct 1 13:06:43 2023 @@ -18,6 +18,7 @@ package Embperl::Form::Validate::Default use strict; use vars qw($VERSION %error_messages %script_functions %prefixes); +use utf8 ; $VERSION = '2.0.0' ; Modified: perl/embperl/trunk/Embperl/Form/Validate/Duration.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/Duration.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/Duration.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/Duration.pm Sun Oct 1 13:06:43 2023 @@ -17,6 +17,7 @@ package Embperl::Form::Validate::Duration ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; my %error_messages = ( Modified: perl/embperl/trunk/Embperl/Form/Validate/EMail.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/EMail.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/EMail.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/EMail.pm Sun Oct 1 13:06:43 2023 @@ -17,12 +17,13 @@ package Embperl::Form::Validate::EMail ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; my %error_messages = ( de => { - validate_email => 'Die eingegebene E-Mail-Adresse "%0" in Feld "%1" ist ungültig, sie muß genau ein "@" enthalten und darf keine Leerzeichen, Klammern oder Umlaute enthalten.', + validate_email => 'Die eingegebene E-Mail-Adresse "%0" in Feld "%1" ist ung�ltig, sie mu� genau ein "@" enthalten und darf keine Leerzeichen, Klammern oder Umlaute enthalten.', validate_email_nomailto => 'Die eingegebene E-Mail-Adresse "%0" in Feld "%1" scheint mit einem "mailto:"; zu beginnen. Bitte geben Sie nur eine E-Mail-Adresse ein und keine mit "mailto:"; beginnende URL.', }, @@ -58,7 +59,7 @@ sub validate my ($self, $key, $value, $fdat, $pref) = @_ ; # The valid address "user@tld" or local addresses are not valid in this more general ruleset - if ($value !~ /^[^ <>()@¡-ÿ]+@[^ <>()@¡-ÿ]+\.[a-zA-Z]{2,4}$/ or + if ($value !~ /^[^ <>()@�-�]+@[^ <>()@�-�]+\.[a-zA-Z]{2,4}$/ or $value =~ /@(\.|.*(\.\.|@))/) { return ['validate_email', $value, $key] ; Modified: perl/embperl/trunk/Embperl/Form/Validate/EMailRFC.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/EMailRFC.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/EMailRFC.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/EMailRFC.pm Sun Oct 1 13:06:43 2023 @@ -17,6 +17,7 @@ package Embperl::Form::Validate::EMailRFC ; use base qw(Embperl::Form::Validate::EMail); +use utf8 ; # -------------------------------------------------------------- Modified: perl/embperl/trunk/Embperl/Form/Validate/FQDN.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/FQDN.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/FQDN.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/FQDN.pm Sun Oct 1 13:06:43 2023 @@ -16,12 +16,13 @@ package Embperl::Form::Validate::FQDN ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; my %error_messages = ( de => { - validate_fqdn => 'Feld %0: "%1" ist keine gültiger Hostname.', + validate_fqdn => 'Feld %0: "%1" ist keine g�ltiger Hostname.', }, en => { Modified: perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm Sun Oct 1 13:06:43 2023 @@ -17,12 +17,13 @@ package Embperl::Form::Validate::FQDN_IPAddr ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; my %error_messages = ( de => { - validate_fqdn_ipaddr => 'Feld %0: "%1" ist keine gültiger Hostname oder IP-Adresse.', + validate_fqdn_ipaddr => 'Feld %0: "%1" ist keine g�ltiger Hostname oder IP-Adresse.', }, 'de.utf-8' => Added: perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPv4_IPv6Addr.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPv4_IPv6Addr.pm?rev=1912655&view=auto ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPv4_IPv6Addr.pm (added) +++ perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPv4_IPv6Addr.pm Sun Oct 1 13:06:43 2023 @@ -0,0 +1,123 @@ + +################################################################################### +# +# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de +# Embperl - Copyright (c) 2008-2014 Gerald Richter +# +# You may distribute under the terms of either the GNU General Public +# License or the Artistic License, as specified in the Perl README file. +# +# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. +# +################################################################################### + + +package Embperl::Form::Validate::FQDN_IPv4_IPv6Addr ; + +use base qw(Embperl::Form::Validate::Default); +use utf8 ; + +my %error_messages = +( + de => + { + validate_fqdn_ipv46addr => 'Feld %0: "%1" ist keine gütiger Hostname oder IP-Adresse.', + }, + + 'de.utf-8' => + { + validate_fqdn_ipv46addr => 'Feld %0: "%1" ist keine gültiger Hostname oder IP-Adresse.', + }, + + en => + { + validate_fqdn_ipv46addr => 'Field %0: "%1" isn\\\'t a valid hostname or ip-address.', + } + ); + + +# -------------------------------------------------------------- + +sub getmsg + { + my ($self, $id, $language, $default_language) = @_ ; + + return $error_messages{$language}{$id} || + $error_messages{$default_language}{$id} || + $self -> SUPER::getmsg ($id, $language, $default_language) ; + } + + +# -------------------------------------------------------------- + +=pod + +see https://stackoverflow.com/questions/53497/regular-expression-that-matches-valid-ipv6-addresses + +# IPv6 RegEx +( +([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}| # 1:2:3:4:5:6:7:8 +([0-9a-fA-F]{1,4}:){1,7}:| # 1:: 1:2:3:4:5:6:7:: +([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}| # 1::8 1:2:3:4:5:6::8 1:2:3:4:5:6::8 +([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}| # 1::7:8 1:2:3:4:5::7:8 1:2:3:4:5::8 +([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}| # 1::6:7:8 1:2:3:4::6:7:8 1:2:3:4::8 +([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}| # 1::5:6:7:8 1:2:3::5:6:7:8 1:2:3::8 +([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}| # 1::4:5:6:7:8 1:2::4:5:6:7:8 1:2::8 +[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})| # 1::3:4:5:6:7:8 1::3:4:5:6:7:8 1::8 +:((:[0-9a-fA-F]{1,4}){1,7}|:)| # ::2:3:4:5:6:7:8 ::2:3:4:5:6:7:8 ::8 :: +fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}| # fe80::7:8%eth0 fe80::7:8%1 (link-local IPv6 addresses with zone index) +::(ffff(:0{1,4}){0,1}:){0,1} +((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3} +(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])| # ::255.255.255.255 ::ffff:255.255.255.255 ::ffff:0:255.255.255.255 (IPv4-mapped IPv6 addresses and IPv4-translated addresses) +([0-9a-fA-F]{1,4}:){1,4}: +((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3} +(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]) # 2001:db8:3:4::192.0.2.33 64:ff9b::192.0.2.33 (IPv4-Embedded IPv6 Address) +) + +# IPv4 RegEx +((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]) + +=cut + + +sub validate + { + my ($self, $key, $value, $fdat, $pref) = @_ ; + + if ($value =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) + { + if ($1 < 0 || $1 > 255 || + $2 < 0 || $2 > 255 || + $3 < 0 || $3 > 255 || + $4 < 0 || $4 > 255) + { + return ['validate_fqdn_ipv46addr', $value] ; + } + else + { + return undef ; + } + } + + return undef if ($value =~ /^[-.a-zA-Z0-9]+$/) ; + + if ($value !~ /^(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))$/) + { + return ['validate_fqdn_ipv46addr', $value] ; + } + return undef; + } + +# -------------------------------------------------------------- + +sub getscript_validate + { + my ($self, $arg, $pref) = @_ ; + + return ('obj.value.search(/^[-.:a-zA-Z0-9]+$/) >= 0 ', ['validate_fqdn_ipv46addr', "'+obj.value+'"]) ; + } + + +1; Added: perl/embperl/trunk/Embperl/Form/Validate/IP6Addr_Mask.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/IP6Addr_Mask.pm?rev=1912655&view=auto ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/IP6Addr_Mask.pm (added) +++ perl/embperl/trunk/Embperl/Form/Validate/IP6Addr_Mask.pm Sun Oct 1 13:06:43 2023 @@ -0,0 +1,73 @@ + +################################################################################### +# +# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de +# Embperl - Copyright (c) 2008-2014 Gerald Richter +# +# You may distribute under the terms of either the GNU General Public +# License or the Artistic License, as specified in the Perl README file. +# +# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. +# +################################################################################### + + +package Embperl::Form::Validate::IP6Addr_Mask ; + +use base qw(Embperl::Form::Validate::Default); + +my %error_messages = +( + de => + { + validate_ip6addr_mask => 'Feld %0: "%1" ist keine gültige IP-Adresse. Geben Sie die IPv6-Adresse in der Form fe80::ffdf:3bae:884e:ba9a ein', + }, + + 'de.utf-8' => + { + validate_ip6addr_mask => 'Feld %0: "%1" ist keine gültige IP-Adresse. Geben Sie die IPv6-Adresse in der Form fe80::ffdf:3bae:884e:ba9a ein', + }, + + en => + { + validate_ip6addr_mask => 'Field %0: "%1" isn\\\'t a valid ip-address. Please enter the ipv6-address like fe80::ffdf:3bae:884e:ba9a', + } + ); + +# -------------------------------------------------------------- + +sub getmsg + { + my ($self, $id, $language, $default_language) = @_ ; + + return $error_messages{$language}{$id} || + $error_messages{$default_language}{$id} || + $self -> SUPER::getmsg ($id, $language, $default_language) ; + } + + +# -------------------------------------------------------------- + +sub validate + { + my ($self, $key, $value, $fdat, $pref) = @_ ; + if ($value !~ /^(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))$/) + { + return ['validate_ip6addr_mask', $value] ; + } + return undef; + } + +# -------------------------------------------------------------- + +sub getscript_validate + { + my ($self, $arg, $pref) = @_ ; + + return ('obj.value.search(/^(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))$/) >= 0', ['validate_ip6addr_mask', "'+obj.value+'"]) ; + } + + +1; Modified: perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm Sun Oct 1 13:06:43 2023 @@ -17,6 +17,7 @@ package Embperl::Form::Validate::IPAddr ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; my %error_messages = ( @@ -54,17 +55,17 @@ sub validate { my ($self, $key, $value, $fdat, $pref) = @_ ; - if ($value =~ /^(\d+)\.(\d+).(\d+)\.(\d+)$/) - { - if ($1 < 0 || $1 > 255 || - $2 < 0 || $2 > 255 || - $3 < 0 || $3 > 255 || - $4 < 0 || $4 > 255) - { - return ['validate_ipaddr', $value] ; - } - return undef ; - } + if ($value =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) + { + if ($1 < 0 || $1 > 255 || + $2 < 0 || $2 > 255 || + $3 < 0 || $3 > 255 || + $4 < 0 || $4 > 255) + { + return ['validate_ipaddr', $value] ; + } + return undef ; + } return ['validate_ipaddr', $value] ; } @@ -74,7 +75,7 @@ sub getscript_validate { my ($self, $arg, $pref) = @_ ; - return ('obj.value.search(/^\d+\.\d+.\d+.\d+$/) >= 0', ['validate_ipaddr', "'+obj.value+'"]) ; + return ('obj.value.search(/^\d+\.\d+\.\d+.\d+$/) >= 0', ['validate_ipaddr', "'+obj.value+'"]) ; } Modified: perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm Sun Oct 1 13:06:43 2023 @@ -17,6 +17,7 @@ package Embperl::Form::Validate::IPAddr_Mask ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; my %error_messages = ( @@ -54,13 +55,13 @@ sub validate { my ($self, $key, $value, $fdat, $pref) = @_ ; - if ($value =~ /^(\d+)\.(\d+).(\d+)\.(\d+)\/(\d+)$/) + if ($value =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\/(\d+)$/) { if ($1 < 0 || $1 > 255 || $2 < 0 || $2 > 255 || $3 < 0 || $3 > 255 || $4 < 0 || $4 > 255 || - $5 < 1 || $5 > 32) + $5 < 0 || $5 > 32) { return ['validate_ipaddr_mask', $value] ; } Added: perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr.pm?rev=1912655&view=auto ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr.pm (added) +++ perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr.pm Sun Oct 1 13:06:43 2023 @@ -0,0 +1,106 @@ + +################################################################################### +# +# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de +# Embperl - Copyright (c) 2008-2014 Gerald Richter +# +# You may distribute under the terms of either the GNU General Public +# License or the Artistic License, as specified in the Perl README file. +# +# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: IPAddr.pm 1578075 2014-03-16 14:01:14Z richter $ +# +################################################################################### + + +package Embperl::Form::Validate::IPv6Addr ; + +use base qw(Embperl::Form::Validate::Default); +use utf8 ; + +my %error_messages = +( + de => + { + validate_ipv6addr => 'Feld %0: "%1" ist keine gültige IPv6-Adresse. Geben Sie die IP-Adresse in der Form n:n:.... ein', + }, + + 'de.utf-8' => + { + validate_ipv6addr => 'Feld %0: "%1" ist keine gültige IPv6-Adresse. Geben Sie die IP-Adresse in der Form n:n:.... ein', + }, + + en => + { + validate_ipv6addr => 'Field %0: "%1" isn\\\'t a valid ipv6-address. Please enter the ip-address as n:n:....', + } + ); + +# -------------------------------------------------------------- + +sub getmsg + { + my ($self, $id, $language, $default_language) = @_ ; + + return $error_messages{$language}{$id} || + $error_messages{$default_language}{$id} || + $self -> SUPER::getmsg ($id, $language, $default_language) ; + } + + +# -------------------------------------------------------------- + +=pod + +see https://stackoverflow.com/questions/53497/regular-expression-that-matches-valid-ipv6-addresses + +# IPv6 RegEx +( +([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}| # 1:2:3:4:5:6:7:8 +([0-9a-fA-F]{1,4}:){1,7}:| # 1:: 1:2:3:4:5:6:7:: +([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}| # 1::8 1:2:3:4:5:6::8 1:2:3:4:5:6::8 +([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}| # 1::7:8 1:2:3:4:5::7:8 1:2:3:4:5::8 +([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}| # 1::6:7:8 1:2:3:4::6:7:8 1:2:3:4::8 +([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}| # 1::5:6:7:8 1:2:3::5:6:7:8 1:2:3::8 +([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}| # 1::4:5:6:7:8 1:2::4:5:6:7:8 1:2::8 +[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})| # 1::3:4:5:6:7:8 1::3:4:5:6:7:8 1::8 +:((:[0-9a-fA-F]{1,4}){1,7}|:)| # ::2:3:4:5:6:7:8 ::2:3:4:5:6:7:8 ::8 :: +fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}| # fe80::7:8%eth0 fe80::7:8%1 (link-local IPv6 addresses with zone index) +::(ffff(:0{1,4}){0,1}:){0,1} +((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3} +(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])| # ::255.255.255.255 ::ffff:255.255.255.255 ::ffff:0:255.255.255.255 (IPv4-mapped IPv6 addresses and IPv4-translated addresses) +([0-9a-fA-F]{1,4}:){1,4}: +((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3} +(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]) # 2001:db8:3:4::192.0.2.33 64:ff9b::192.0.2.33 (IPv4-Embedded IPv6 Address) +) + +# IPv4 RegEx +((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]) + +=cut + + +sub validate + { + my ($self, $key, $value, $fdat, $pref) = @_ ; + if ($value !~ /^(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))$/) + { + return ['validate_ipv6addr', $value] ; + } + return undef; + } + +# -------------------------------------------------------------- + +sub getscript_validate + { + my ($self, $arg, $pref) = @_ ; + + return ('obj.value.search(/^(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))$/) >= 0', ['validate_ipv6addr', "'+obj.value+'"]) ; + } + + +1; Added: perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr_Mask.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr_Mask.pm?rev=1912655&view=auto ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr_Mask.pm (added) +++ perl/embperl/trunk/Embperl/Form/Validate/IPv6Addr_Mask.pm Sun Oct 1 13:06:43 2023 @@ -0,0 +1,110 @@ + +################################################################################### +# +# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de +# Embperl - Copyright (c) 2008-2014 Gerald Richter +# +# You may distribute under the terms of either the GNU General Public +# License or the Artistic License, as specified in the Perl README file. +# +# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: IPAddr_Mask.pm 1578075 2014-03-16 14:01:14Z richter $ +# +################################################################################### + + +package Embperl::Form::Validate::IPv6Addr_Mask ; + +use base qw(Embperl::Form::Validate::Default); +use utf8 ; + +my %error_messages = +( + de => + { + validate_ipv6addr_mask => 'Feld %0: "%1" ist keine gültige IPv6-Adresse/Netzmaske. Geben Sie die IP-Adresse/Netzmaske in der Form n:n:..../mm ein', + }, + + 'de.utf-8' => + { + validate_ipv6addr_mask => 'Feld %0: "%1" ist keine gültige IPv6-Adresse/Netzmaske. Geben Sie die IP-Adresse/Netzmaske in der Form n:n:..../mm ein', + }, + + en => + { + validate_ipv6addr_mask => 'Field %0: "%1" isn\\\'t a valid ipv6-address/netmask. Please enter the ip-address/netmask as n:n:..../mm', + } + ); + +# -------------------------------------------------------------- + +sub getmsg + { + my ($self, $id, $language, $default_language) = @_ ; + + return $error_messages{$language}{$id} || + $error_messages{$default_language}{$id} || + $self -> SUPER::getmsg ($id, $language, $default_language) ; + } + + +# -------------------------------------------------------------- + +=pod + +see https://stackoverflow.com/questions/53497/regular-expression-that-matches-valid-ipv6-addresses + +# IPv6 RegEx +( +([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}| # 1:2:3:4:5:6:7:8 +([0-9a-fA-F]{1,4}:){1,7}:| # 1:: 1:2:3:4:5:6:7:: +([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}| # 1::8 1:2:3:4:5:6::8 1:2:3:4:5:6::8 +([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}| # 1::7:8 1:2:3:4:5::7:8 1:2:3:4:5::8 +([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}| # 1::6:7:8 1:2:3:4::6:7:8 1:2:3:4::8 +([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}| # 1::5:6:7:8 1:2:3::5:6:7:8 1:2:3::8 +([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}| # 1::4:5:6:7:8 1:2::4:5:6:7:8 1:2::8 +[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})| # 1::3:4:5:6:7:8 1::3:4:5:6:7:8 1::8 +:((:[0-9a-fA-F]{1,4}){1,7}|:)| # ::2:3:4:5:6:7:8 ::2:3:4:5:6:7:8 ::8 :: +fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}| # fe80::7:8%eth0 fe80::7:8%1 (link-local IPv6 addresses with zone index) +::(ffff(:0{1,4}){0,1}:){0,1} +((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3} +(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])| # ::255.255.255.255 ::ffff:255.255.255.255 ::ffff:0:255.255.255.255 (IPv4-mapped IPv6 addresses and IPv4-translated addresses) +([0-9a-fA-F]{1,4}:){1,4}: +((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3} +(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]) # 2001:db8:3:4::192.0.2.33 64:ff9b::192.0.2.33 (IPv4-Embedded IPv6 Address) +) + +# IPv4 RegEx +((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]) + +=cut + + +sub validate + { + my ($self, $key, $value, $fdat, $pref) = @_ ; + if ($value !~ /^(?:(?:[0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|(?:[0-9a-fA-F]{1,4}:){1,7}:|(?:[0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|(?:[0-9a-fA-F]{1,4}:){1,5}(?::[0-9a-fA-F]{1,4}){1,2}|(?:[0-9a-fA-F]{1,4}:){1,4}(?::[0-9a-fA-F]{1,4}){1,3}|(?:[0-9a-fA-F]{1,4}:){1,3}(?::[0-9a-fA-F]{1,4}){1,4}|(?:[0-9a-fA-F]{1,4}:){1,2}(?::[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:(?:(?::[0-9a-fA-F]{1,4}){1,6})|:(?:(?::[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(?::[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(?:ffff(?::0{1,4}){0,1}:){0,1}(?:(?:25[0-5]|(?:2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(?:25[0-5]|(?:2[0-4]|1{0,1}[0-9]){0,1}[0-9])|(?:[0-9a-fA-F]{1,4}:){1,4}:(?:(?:25[0-5]|(?:2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(?:25[0-5]|(?:2[0-4]|1{0,1}[0-9]){0,1}[0-9]))\/([0-9]{1,3})$/) + { + return ['validate_ipv6addr_mask', $value] ; + } + if ($1 < 0 || $1 > 128) + { + return ['validate_ipv6addr_mask', $value] ; + } + return undef; + } + +# -------------------------------------------------------------- + +sub getscript_validate + { + my ($self, $arg, $pref) = @_ ; + + return ('obj.value.search(/^(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))\/([0-9]{1,3})$/) >= 0', ['validate_ipv6addr_mask', "'+obj.value+'"]) ; + } + + +1; Modified: perl/embperl/trunk/Embperl/Form/Validate/Number.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/Number.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/Number.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/Number.pm Sun Oct 1 13:06:43 2023 @@ -17,6 +17,7 @@ package Embperl::Form::Validate::Number ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; my $VERSION = '2.0.0' ; Modified: perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm Sun Oct 1 13:06:43 2023 @@ -17,6 +17,7 @@ package Embperl::Form::Validate::PosInteger ; use base qw(Embperl::Form::Validate::Integer); +use utf8 ; my %error_messages = ( Modified: perl/embperl/trunk/Embperl/Form/Validate/Select.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/Select.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/Select.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/Select.pm Sun Oct 1 13:06:43 2023 @@ -17,6 +17,7 @@ package Embperl::Form::Validate::Select ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; # -------------------------------------------------------------- Modified: perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm Sun Oct 1 13:06:43 2023 @@ -17,6 +17,7 @@ package Embperl::Form::Validate::TimeHHMM ; use base qw(Embperl::Form::Validate::Default); +use utf8 ; my %error_messages = ( Modified: perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm (original) +++ perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm Sun Oct 1 13:06:43 2023 @@ -17,6 +17,7 @@ package Embperl::Form::Validate::TimeValue ; use base qw(Embperl::Form::Validate::Integer); +use utf8 ; my %error_messages = ( Modified: perl/embperl/trunk/Embperl/Inline.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Inline.pm?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Inline.pm (original) +++ perl/embperl/trunk/Embperl/Inline.pm Sun Oct 1 13:06:43 2023 @@ -11,8 +11,7 @@ # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED # WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. # -# $Id$ -# + ################################################################################### Modified: perl/embperl/trunk/MANIFEST URL: http://svn.apache.org/viewvc/perl/embperl/trunk/MANIFEST?rev=1912655&r1=1912654&r2=1912655&view=diff ============================================================================== --- perl/embperl/trunk/MANIFEST (original) +++ perl/embperl/trunk/MANIFEST Sun Oct 1 13:06:43 2023 @@ -57,6 +57,10 @@ Embperl/Form/Validate/EMailRFC.pm Embperl/Form/Validate/FQDN_IPAddr.pm Embperl/Form/Validate/IPAddr.pm Embperl/Form/Validate/IPAddr_Mask.pm +Embperl/Form/Validate/FQDN_IPv4_IPv6Addr.pm +Embperl/Form/Validate/IP6Addr_Mask.pm +Embperl/Form/Validate/IPv6Addr.pm +Embperl/Form/Validate/IPv6Addr_Mask.pm Embperl/Form/Validate/Integer.pm Embperl/Form/Validate/PosInteger.pm Embperl/Form/Validate/Select.pm --------------------------------------------------------------------- To unsubscribe, e-mail: embperl-cvs-unsubscr...@perl.apache.org For additional commands, e-mail: embperl-cvs-h...@perl.apache.org
