richter at apache
Feb 24, 2003, 12:23 AM
Views: 674
Permalink
|
|
cvs commit: embperl/test/html epform.htm
|
|
richter 2003/02/23 23:23:02
Modified: . Changes.pod test.pl
Embperl/Form Validate.pm
Embperl/Form/Validate IPAddr.pm IPAddr_Mask.pm
test/cmp epform.htm escape.htm
test/html epform.htm
Added: Embperl/Form/Validate EMail.pm EMailRFC.pm TimeHHMM.pm
TimeHHMMSS.pm
Removed: test/cmp2 escape.htm
Log:
-type email & time and test fixes
Revision Changes Path
1.202 +2 -1 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.201
retrieving revision 1.202
diff -u -r1.201 -r1.202
--- Changes.pod 19 Feb 2003 08:30:04 -0000 1.201
+++ Changes.pod 24 Feb 2003 07:23:00 -0000 1.202
@@ -63,7 +63,8 @@
- 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.
+ - Added -type => Integer, IPAddr, IPAddr_Net, TimeHHMM, TimeHHMMSS,
+ EMail and EMailRFC to Embperl::Form::Validate.
=head1 2.0b8 (BETA) 25. Juni 2002
1.125 +3 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.124
retrieving revision 1.125
diff -u -r1.124 -r1.125
--- test.pl 15 Feb 2003 20:46:32 -0000 1.124
+++ test.pl 24 Feb 2003 07:23:00 -0000 1.125
@@ -1018,6 +1018,8 @@
$^W = 1 ;
$| = 1;
+ $ENV{EMBPERL_COOKIE_EXPIRES} = '+120s' ;
+
if (($ARGV[0] || '') eq '--testlib')
{
eval 'use ExtUtils::testlib' ;
@@ -1749,7 +1751,6 @@
$cp -> share ('$testshare') ;
$ENV{EMBPERL_ALLOW} = 'asc|\\.xml$|\\.htm$|\\.htm-1$' ;
-$ENV{EMBPERL_COOKIE_EXPIRE} = '+120s' ;
#Embperl::log ("Start testing...\n") ; # force logfile open
1.5 +53 -8 embperl/Embperl/Form/Validate.pm
Index: Validate.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- Validate.pm 19 Feb 2003 08:30:04 -0000 1.4
+++ Validate.pm 24 Feb 2003 07:23:01 -0000 1.5
@@ -134,7 +134,7 @@
Adds rules $field_rules for a (new) field $field to the validator,
e.g.
- $epf->add_rule([. -key => 'fnord', -type => 'Float', -max => 1.3, -name => 'Fnord' ]);
+ $epf->add_rule([. -key => 'fnord', -type => 'Number', -max => 1.3, -name => 'Fnord' ]);
The new rule will be appended to the end of the list of rules.
@@ -674,7 +674,7 @@
],
[.
-key => 'from',
- -type => 'Date',
+ -type => 'EMail',
emptyok => 1,
],
@@ -707,13 +707,58 @@
specfify to not use the standard tests, but the ones for a special type.
For example there is a type C<Number> which will replaces all the comparsions
by numeric ones instead of string comparisions. You may add your own types
-by wrting a module that contains the necessary test and dropping it under
+by writing a module that contains the necessary test and dropping it under
Embperl::Form::Validate::<Typename>. The -type directive also can verfiy
that the given data has a valid format for the type.
-At the moment the only types that are available is C<Default> and C<Number>.
-The first is the default and need not to be specified. If you are writing new
-type make sure to send them back, so they can be part of the next distribution.
+The following types are available:
+
+=over
+
+=item Default
+
+This one is used when no type is specified. It contains all the standart
+tests.
+
+=item Number
+
+Input must be a floating point number.
+
+=item Integer
+
+Input must be a integer number.
+
+=item TimeHHMM
+
+Input must be the time in the format hh::mm
+
+=item TimeHHMMSS
+
+Input must be the time in the format hh::mm:ss
+
+=item EMail
+
+Input must be a valid email address including a top level domain
+e.g. user [at] example
+
+=item EMailRFC
+
+Input must be a valid email adress, no top level domain is required,
+so user [at] fo is also valid.
+
+=item IPAddr
+
+Input must be an ip-address in the form nnn.nnn.nnn.nnn
+
+=item IPAddr_Mask
+
+Input must be an ip-address and network mask in the form nnn.nnn.nnn.nnn/mm
+
+=back
+
+
+If you write your own type package,
+make sure to send them back, so they can be part of the next distribution.
=item -msg
1.2 +1 -1 embperl/Embperl/Form/Validate/IPAddr.pm
Index: IPAddr.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate/IPAddr.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- IPAddr.pm 19 Feb 2003 08:30:05 -0000 1.1
+++ IPAddr.pm 24 Feb 2003 07:23:01 -0000 1.2
@@ -28,7 +28,7 @@
en =>
{
- validate_ipaddr => 'Field %0: "%1" isn\'t a valid ip-address. Please enter the ip-address as nnn.nnn.nnn.nnn',
+ validate_ipaddr => 'Field %0: "%1" isn\\\'t a valid ip-address. Please enter the ip-address as nnn.nnn.nnn.nnn',
}
);
1.2 +1 -1 embperl/Embperl/Form/Validate/IPAddr_Mask.pm
Index: IPAddr_Mask.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate/IPAddr_Mask.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- IPAddr_Mask.pm 19 Feb 2003 08:30:05 -0000 1.1
+++ IPAddr_Mask.pm 24 Feb 2003 07:23:01 -0000 1.2
@@ -28,7 +28,7 @@
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',
+ 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',
}
);
1.1 embperl/Embperl/Form/Validate/EMail.pm
Index: EMail.pm
===================================================================
###################################################################################
#
# Embperl - Copyright (c) 1997-2003 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: EMail.pm,v 1.1 2003/02/24 07:23:01 richter Exp $
#
###################################################################################
package Embperl::Form::Validate::EMail ;
use base qw(Embperl::Form::Validate::Default);
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_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.',
},
en =>
{
validate_email => 'The given e-mail address "%0" in field "%1" is not valid. It must have exactly one "@" and must not contain any blanks, parentheses or special charactes like umlauts.',
validate_email_nomailto => 'The given e-mail address "%0" in field "%1" seems to be prepended by "mailto:". Please enter only an e-mail address and no URL starting with "mailto:".',
}
);
# --------------------------------------------------------------
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) = @_ ;
# The valid address "user [at] tl" or local addresses are not valid in this more general ruleset
if ($value !~ /^[^ <>()@”-’]+@[^ <>()@”-’]+\.[a-zA-Z]{2,4}$/ or
$value =~ /@(\.|.*(\.\.|@))/)
{
return ['validate_email', $value, $key] ;
}
if ($value =~ /^mailto:/i)
{
return ['validate_email_nomailto', $value, $key] ;
}
return undef ;
}
# --------------------------------------------------------------
sub getscript_validate
{
my ($self, $arg, $pref) = @_ ;
return ('((obj.value.search(/^[^ <>()@”-’]+@[^ <>()@”-’]+\.[a-zA-Z]{2,4}$/) >= 0) && (obj.value.search(/@(\.|.*(\.\.|@))|mailto:/i) < 0))',
['validate_email', "'+obj.value+'"]) ;
}
1;
1.1 embperl/Embperl/Form/Validate/EMailRFC.pm
Index: EMailRFC.pm
===================================================================
###################################################################################
#
# Embperl - Copyright (c) 1997-2003 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: EMailRFC.pm,v 1.1 2003/02/24 07:23:01 richter Exp $
#
###################################################################################
package Embperl::Form::Validate::EMailRFC ;
use base qw(Embperl::Form::Validate::EMail);
# --------------------------------------------------------------
sub validate
{
my ($self, $key, $value, $fdat, $pref) = @_ ;
# The valid address "user [at] tl" or local addresses are valid in this RFC conforming ruleset
if ($value !~ /^[^ <>()@”-’]+@[^ <>()@”-’]+$/ or
$value =~ /@(\.|.*(\.\.|@))/)
{
return ['validate_email', $value, $key] ;
}
if ($value =~ /^mailto:/i)
{
return ['validate_email_nomailto', $value, $key] ;
}
return undef ;
}
# --------------------------------------------------------------
sub getscript_validate
{
my ($self, $arg, $pref) = @_ ;
return ('((obj.value.search(/^[^ <>()@”-’]+@[^ <>()@”-’]+$/) >= 0) && (obj.value.search(/@(\.|.*(\.\.|@))|mailto:/i) < 0))',
['validate_email', "'+obj.value+'"]) ;
}
1;
1.1 embperl/Embperl/Form/Validate/TimeHHMM.pm
Index: TimeHHMM.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: TimeHHMM.pm,v 1.1 2003/02/24 07:23:01 richter Exp $
#
###################################################################################
package Embperl::Form::Validate::Time ;
use base qw(Embperl::Form::Validate::Default);
my %error_messages =
(
de =>
{
validate_time => 'Feld %0: "%1" ist kein gültiges Zeitformat. Geben Sie die Zeit in der Form hh:mm ein',
},
en =>
{
validate_time => 'Field %0: "%1" isn\\\'t a valid time. Please enter the time as hh: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)$/)
{
if ($1 < 0 || $1 > 23 ||
$2 < 0 || $2 > 59 )
{
return ['validate_time', $value] ;
}
return undef ;
}
return ['validate_time', $value] ;
}
# --------------------------------------------------------------
sub getscript_validate
{
my ($self, $arg, $pref) = @_ ;
return ('obj.value.search(/^\d{2}\:\d{2}$/) >= 0', ['validate_time', "'+obj.value+'"]) ;
}
1;
1.1 embperl/Embperl/Form/Validate/TimeHHMMSS.pm
Index: TimeHHMMSS.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: TimeHHMMSS.pm,v 1.1 2003/02/24 07:23:01 richter Exp $
#
###################################################################################
package Embperl::Form::Validate::Time_Long ;
use base qw(Embperl::Form::Validate::Default);
my %error_messages =
(
de =>
{
validate_time_long => 'Feld %0: "%1" ist kein gültiges Zeitformat. Geben Sie die Zeit in der Form hh:mm:ss ein',
},
en =>
{
validate_time_long => 'Field %0: "%1" isn\\\'t a valid time. Please enter the time as hh:mm:ss',
}
);
# --------------------------------------------------------------
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\d)$/)
{
if ($1 < 0 || $1 > 23 ||
$2 < 0 || $2 > 59 ||
$3 < 0 || $3 > 59)
{
return ['validate_time_long', $value] ;
}
return undef ;
}
return ['validate_time_long', $value] ;
}
# --------------------------------------------------------------
sub getscript_validate
{
my ($self, $arg, $pref) = @_ ;
return ('obj.value.search(/^\d\d:\d\d:\d\d$/) >= 0', ['validate_time_long', "'+obj.value+'"]) ;
}
1;
1.2 +3 -1 embperl/test/cmp/epform.htm
Index: epform.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/epform.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- epform.htm 23 Dec 2002 10:08:54 -0000 1.1
+++ epform.htm 24 Feb 2003 07:23:02 -0000 1.2
@@ -24,12 +24,14 @@
do {
obj = document.foo['datum'] ; if (!(obj.value)) { msgs[i++]='Bitte Datum eintragen'; break;}
+obj = document.foo['datum'] ; if (!(obj.value.search(/\d+\.\d+\.\d+/) >= 0)) { msgs[i++]='Datum überprüfen'; break;}
} while (0) ; if (fail) break ;
do {
obj = document.foo['stunden'] ; if (!(obj.value)) { msgs[i++]='Bitte Stunden eintragen'; break;}
-obj = document.foo['stunden'] ; if (!(obj.value > 0)) { msgs[i++]='Stundenzahl nicht numerisch'; break;}
+obj = document.foo['stunden'] ; if (!(obj.value.search(/^\s*[0-9+-.][0-9.eE]*\s*$/) >= 0)) { msgs[i++]='Stundenzahl nicht numerisch'; break;}
+obj = document.foo['stunden'] ; if (!(obj.value > 0)) { msgs[i++]='Stundenzahl muß >0 sein'; break;}
} while (0) ; if (fail) break ;
1.26 +22 -0 embperl/test/cmp/escape.htm
Index: escape.htm
===================================================================
RCS file: /home/cvs/embperl/test/cmp/escape.htm,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- escape.htm 22 Oct 2002 05:29:09 -0000 1.25
+++ escape.htm 24 Feb 2003 07:23:02 -0000 1.26
@@ -194,6 +194,28 @@
^<a href="7\?(!Table=interface%2Crouter&%24where=interface.router_id%3Drouter.id|%24where=interface.router_id%3Drouter.id&!Table=interface%2Crouter)">
+--> my
+
+ <b>hello
+<b>hello
+<br><br>reset<br>
+ <b>helloin++
+ <b>hello
+<b>hello
+<br><br>reset<br>
+ <b>hello
+<b>hello
+--> local
+
+ <b>hello
+<b>hello
+<br><br>reset<br>
+ <b>helloin++
+ <b>hello
+<b>hello
+<br><br>reset<br>
+ <b>hello
+<b>hello
<P>Ok.<P>
1.2 +1 -2 embperl/test/html/epform.htm
Index: epform.htm
===================================================================
RCS file: /home/cvs/embperl/test/html/epform.htm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- epform.htm 23 Dec 2002 10:08:55 -0000 1.1
+++ epform.htm 24 Feb 2003 07:23:02 -0000 1.2
@@ -20,8 +20,7 @@
-msg => 'Bitte Stunden eintragen',
required => 1,
-msg => 'Stundenzahl nicht numerisch', # fail-msg for next test
- -type => 'Number', # only Number and Default
- available
+ -type => 'Number', # only Number and Default available
-msg => 'Stundenzahl muß >0 sein', # fail-msg for next test
gt => 0,
],
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe [at] perl
For additional commands, e-mail: embperl-cvs-help [at] perl
|
cvs commit: embperl/test/html epform.htm