richter 2003/02/19 00:30:05
Modified: . Changes.pod
Embperl/Form Validate.pm
Embperl/Form/Validate Default.pm Integer.pm Number.pm
Added: Embperl/Form/Validate IPAddr.pm IPAddr_Mask.pm
Log:
validate -type IPAddr, IPAddr_Net, Integer
Revision Changes Path
1.201 +1 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.200
retrieving revision 1.201
diff -u -r1.200 -r1.201
--- Changes.pod 15 Feb 2003 20:46:31 -0000 1.200
+++ Changes.pod 19 Feb 2003 08:30:04 -0000 1.201
@@ -63,6 +63,7 @@
- EMBPERL_COOKIE_EXPIRES now again accepts relatives times like +2h.
- embpexec.pl now correctly takes config values from environment
for application object.
+ - Added -type => Integer, IPAddr, IPAddr_Net to Embperl::Form::Validate.
=head1 2.0b8 (BETA) 25. Juni 2002
1.4 +3 -3 embperl/Embperl/Form/Validate.pm
Index: Validate.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Validate.pm 20 Nov 2002 06:56:27 -0000 1.3
+++ Validate.pm 19 Feb 2003 08:30:04 -0000 1.4
@@ -270,7 +270,7 @@
my $arg = $frules -> [$i++] ;
foreach my $k (@$keys)
{
- $status = &$action($k, $fdat -> {$name}, $arg, $fdat, $pref) ;
+ $status = &$action($k, $fdat -> {$k}, $arg, $fdat, $pref) ;
last if (!$status) ;
}
}
1.3 +50 -11 embperl/Embperl/Form/Validate/Default.pm
Index: Default.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate/Default.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Default.pm 22 Oct 2002 05:39:49 -0000 1.2
+++ Default.pm 19 Feb 2003 08:30:05 -0000 1.3
@@ -40,10 +40,10 @@
validate_length_max => 'Inhalt des Feldes %0 ist zu lang, maximale L�nge sind
%2, eingegeben wurden %1 Zeichen',
validate_length_min => 'Inhalt des Feldes %0 ist zu kurz, minimal L�nge sind
%2, eingegeben wurden %1 Zeichen',
validate_length_eq => 'Inhalt des Feldes %0 hat die falsche L�nge: Er sollte
%2 Zeichen lang sein, ist aber %1 lang',
- validate_matches_regexp => 'Inhalt "%1" des Feldes %0 entspricht nicht dem
regul�ren Ausdruck /%2/',
- validate_matches_regexp_js => 'Inhalt "%1" des Feldes %0 entspricht nicht dem
regul�ren Ausdruck /%2/',
- validate_not_matches_regexp => 'Inhalt "%1" des Feldes %0 darf nicht dem
regul�ren Ausdruck /%2/ entsprechen',
- validate_not_matches_regexp_js => 'Inhalt "%1" des Feldes %0 darf nicht dem
regul�ren Ausdruck /%2/ entsprechen',
+ validate_matches_regex => 'Inhalt "%1" des Feldes %0 entspricht nicht dem
regul�ren Ausdruck /%2/',
+ validate_matches_regex_js => 'Inhalt "%1" des Feldes %0 entspricht nicht dem
regul�ren Ausdruck /%2/',
+ validate_not_matches_regex => 'Inhalt "%1" des Feldes %0 darf nicht dem
regul�ren Ausdruck /%2/ entsprechen',
+ validate_not_matches_regex_js => 'Inhalt "%1" des Feldes %0 darf nicht dem
regul�ren Ausdruck /%2/ entsprechen',
validate_matches_wildcard => 'Inhalt "%1" des Feldes %0 entspricht nicht dem
Wildcard-Ausdruck "%2"',
validate_must_only_contain => 'Das Feld %0 darf nur folgende Zeichen
enthalten: "%2"',
validate_must_contain_one_of => 'Das Feld %0 mu� mindestens eines der
folgenden Zeichen enthalten: "%2"',
@@ -63,10 +63,10 @@
validate_length_max => 'Content of field %0 is too long, has %1 characters,
maximum is %2 characters',
validate_length_min => 'Content of field %0 is too short, has %1 characters,
minimum is %2 characters',
validate_length_eq => 'Content of field %0 has wrong length: It is %1
characters long, but should be %2 characters long',
- validate_matches_regexp => 'Field %0 doesn"t match regexp /%2/',
- validate_matches_regexp_js => 'Field %0 doesn"t match regexp /%2/',
- validate_not_matches_regexp => 'Field %0 must not match regexp /%2/',
- validate_not_matches_regexp_js => 'Field %0 must not match regexp /%2/',
+ validate_matches_regex => 'Field %0 doesn"t match regexp /%2/',
+ validate_matches_regex_js => 'Field %0 doesn"t match regexp /%2/',
+ validate_not_matches_regex => 'Field %0 must not match regexp /%2/',
+ validate_not_matches_regex_js => 'Field %0 must not match regexp /%2/',
validate_matches_wildcard => 'Field %0 doesn"t match wildcard expression "%2"',
validate_must_only_contain => 'Field %0 must contain only the following
characters: "%2"',
validate_must_contain_one_of => 'Field %0 must contain one of the following
characters: "%2"',
@@ -345,6 +345,15 @@
# --------------------------------------------------------------
+sub validate_matches_regex_perl
+ {
+ my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
+
+ return ($value =~ /$arg/) ? undef : ['validate_matches_regex', $value, $arg] ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_matches_regex_js
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -353,6 +362,17 @@
}
# --------------------------------------------------------------
+
+sub getscript_matches_regex
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ $arg =~ s(/)(\\/)g; # JS needs / escaping
+ return ("obj.value.search(/$arg/) >= 0", ['validate_matches_regex',
"'+obj.value+'", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub getscript_matches_regex_js
{
my ($self, $arg, $pref) = @_ ;
@@ -372,6 +392,15 @@
# --------------------------------------------------------------
+sub validate_not_matches_regex_perl
+ {
+ my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
+
+ return ($value !~ /$arg/) ? undef : ['validate_not_matches_regex', $value,
$arg] ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_not_matches_regex_js
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -381,12 +410,22 @@
# --------------------------------------------------------------
+sub getscript_not_matches_regex
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ $arg =~ s(/)(\\/)g; # JS needs / escaping
+ return ("obj.value.search(/$arg/) < 0", ['validate_not_matches_regex',
"'+obj.value+'", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub getscript_not_matches_regex_js
{
my ($self, $arg, $pref) = @_ ;
$arg =~ s(/)(\\/)g; # JS needs / escaping
- return ("obj.value.search(/$arg/) < 0", ['validate_matches_regex',
"'+obj.value+'", $arg]) ;
+ return ("obj.value.search(/$arg/) < 0", ['validate_not_matches_regex',
"'+obj.value+'", $arg]) ;
}
# --------------------------------------------------------------
1.2 +11 -1 embperl/Embperl/Form/Validate/Integer.pm
Index: Integer.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate/Integer.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Integer.pm 20 Nov 2002 07:00:18 -0000 1.1
+++ Integer.pm 19 Feb 2003 08:30:05 -0000 1.2
@@ -29,5 +29,15 @@
return $value =~ /^\s*[0-9+-][0-9]*\s*$/ ? undef : ['validate_number', $value] ;
}
+# --------------------------------------------------------------
+
+sub getscript_validate
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ('obj.value.search(/^\s*[0-9+-][0-9]*\s*$/) >= 0', ['validate_number',
"'+obj.value+'"]) ;
+ }
+
+
1;
1.3 +12 -3 embperl/Embperl/Form/Validate/Number.pm
Index: Number.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate/Number.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Number.pm 22 Oct 2002 05:39:49 -0000 1.2
+++ Number.pm 19 Feb 2003 08:30:05 -0000 1.3
@@ -53,7 +53,16 @@
{
my ($self, $key, $value, $fdat, $pref) = @_ ;
- return $value =~ /^\s*[0-9.+-eE]+\s*$/ ? undef : ['validate_number', $value] ;
+ return $value =~ /^\s*[0-9+-.][0-9.eE]*\s*$/ ? undef : ['validate_number',
$value] ;
+ }
+
+# --------------------------------------------------------------
+
+sub getscript_validate
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ('obj.value.search(/^\s*[0-9+-.][0-9.eE]*\s*$/) >= 0',
['validate_number', "'+obj.value+'"]) ;
}
# --------------------------------------------------------------
1.1 embperl/Embperl/Form/Validate/IPAddr.pm
Index: IPAddr.pm
===================================================================
###################################################################################
#
# Embperl - Copyright (c) 1997-2002 Gerald Richter / ecos gmbh www.ecos.de
#
# 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,v 1.1 2003/02/19 08:30:05 richter Exp $
#
###################################################################################
package Embperl::Form::Validate::IPAddr ;
use base qw(Embperl::Form::Validate::Default);
my %error_messages =
(
de =>
{
validate_ipaddr => 'Feld %0: "%1" ist keine g�ltige IP-Adresse. Geben Sie die
IP-Adresse in der Form nnn.nnn.nnn.nnn ein',
},
en =>
{
validate_ipaddr => 'Field %0: "%1" isn\'t a valid ip-address. Please enter the
ip-address as nnn.nnn.nnn.nnn',
}
);
# --------------------------------------------------------------
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 =~ /^(\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] ;
}
# --------------------------------------------------------------
sub getscript_validate
{
my ($self, $arg, $pref) = @_ ;
return ('obj.value.search(/^\d+\.\d+.\d+.\d+$/) >= 0', ['validate_ipaddr',
"'+obj.value+'"]) ;
}
1;
1.1 embperl/Embperl/Form/Validate/IPAddr_Mask.pm
Index: IPAddr_Mask.pm
===================================================================
###################################################################################
#
# Embperl - Copyright (c) 1997-2002 Gerald Richter / ecos gmbh www.ecos.de
#
# 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,v 1.1 2003/02/19 08:30:05 richter Exp $
#
###################################################################################
package Embperl::Form::Validate::IPAddr_Mask ;
use base qw(Embperl::Form::Validate::Default);
my %error_messages =
(
de =>
{
validate_ipaddr_mask => 'Feld %0: "%1" ist keine g�ltige IP-Adresse/Netzmaske.
Geben Sie die IP-Adresse/Netzmaske in der Form nnn.nnn.nnn.nnn/mm ein',
},
en =>
{
validate_ipaddr_mask => 'Field %0: "%1" isn\'t a valid ip-address/netmask.
Please enter the ip-address/netmask as nnn.nnn.nnn.nnn/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) ;
}
# --------------------------------------------------------------
sub validate
{
my ($self, $key, $value, $fdat, $pref) = @_ ;
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)
{
return ['validate_ipaddr_mask', $value] ;
}
return undef ;
}
return ['validate_ipaddr_mask', $value] ;
}
# --------------------------------------------------------------
sub getscript_validate
{
my ($self, $arg, $pref) = @_ ;
return ('obj.value.search(/^\d+\.\d+.\d+.\d+\/\d+$/) >= 0',
['validate_ipaddr_mask', "'+obj.value+'"]) ;
}
1;
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
