richter 02/03/07 22:44:14
Modified: . Tag: Embperl2c TODO
Embperl/Form Tag: Embperl2c Validate.pm
Embperl/Form/Validate Tag: Embperl2c Default.pm Number.pm
eg Tag: Embperl2c README
Added: eg/x Tag: Embperl2c formvalidation.htm
Log:
form validation
Revision Changes Path
No revision
No revision
1.97.4.8 +2 -0 embperl/TODO
Index: TODO
===================================================================
RCS file: /home/cvs/embperl/TODO,v
retrieving revision 1.97.4.7
retrieving revision 1.97.4.8
diff -u -r1.97.4.7 -r1.97.4.8
--- TODO 2 Nov 2001 11:34:25 -0000 1.97.4.7
+++ TODO 8 Mar 2002 06:44:14 -0000 1.97.4.8
@@ -100,6 +100,8 @@
- Execute inside html tags [Jonny Cavell 26.4.01]
+- $fdat_ref = $set; [Kee Hinckley 7.3.02]
+
Docs 2.0
--------
No revision
No revision
1.1.2.10 +102 -11 embperl/Embperl/Form/Attic/Validate.pm
Index: Validate.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Attic/Validate.pm,v
retrieving revision 1.1.2.9
retrieving revision 1.1.2.10
diff -u -r1.1.2.9 -r1.1.2.10
--- Validate.pm 7 Mar 2002 07:12:31 -0000 1.1.2.9
+++ Validate.pm 8 Mar 2002 06:44:14 -0000 1.1.2.10
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Validate.pm,v 1.1.2.9 2002/03/07 07:12:31 richter Exp $
+# $Id: Validate.pm,v 1.1.2.10 2002/03/08 06:44:14 richter Exp $
#
###################################################################################
@@ -20,7 +20,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = q$Id: Validate.pm,v 1.1.2.9 2002/03/07 07:12:31 richter Exp $;
+$VERSION = q$Id: Validate.pm,v 1.1.2.10 2002/03/08 06:44:14 richter Exp $;
=head1 NAME
@@ -340,7 +340,7 @@
my ($self, $fdat, $pref, $epreq) = @_ ;
$epreq ||= $Embperl::req ;
- $fdat ||= $epreq -> thread -> fdat ;
+ $fdat ||= $epreq -> thread -> form_hash ;
my @result ;
$self -> validate_rules ($self->{frules}, $fdat, $pref, \@result) ;
@@ -357,7 +357,7 @@
my $default_language = $pref -> {default_language} ;
my $txt ;
- my $name ||= $key ;
+ $name ||= $key ;
if (ref $name eq 'ARRAY')
{
my @names ;
@@ -534,7 +534,7 @@
if ($typeobj -> can ($method))
{
($code, $msgparam) = $typeobj -> $method ($arg, $pref) ;
- $scriptcode -> {$k} = [$code, $msgparam, $i - $j] ;
+ $scriptcode -> {$k} = [$code, $msgparam] ;
}
else
{
@@ -563,14 +563,13 @@
}
if (!ref $key)
{
-
- $script .= "obj = document.$form.$key ; if ($code) { $setmsg "
. ($param{fail}?'fail=1;break;':($param{cont}?'':'break;')) . "}\n" ;
+ $script .= "obj = document.$form.$key ; if (!($code)) { $setmsg
" . ($param{fail}?'fail=1;break;':($param{cont}?'':'break;')) . "}\n" ;
}
else
{
foreach my $k (@$keys)
{
- $script .= "obj = document.$form.$k ; if ($code) {" ;
+ $script .= "obj = document.$form.$k ; if (!($code)) {" ;
}
$script .= " $setmsg " .
($param{fail}?'fail=1;break;':($param{cont}?'':'break;')) . "\n" ;
@@ -609,7 +608,7 @@
[+ do { local $escmode = 0 ; $epf -> get_script_code } +]
</script>
- <form name="foo" action="POST" onSubmit="epform_validate_foo()">
+ <form name="foo" action="POST" onSubmit="return epform_validate_foo()">
....
</form>
@@ -629,11 +628,11 @@
$script = $self -> gather_script_code ($self->{frules}, $pref, $epreq) ;
my $fname = $self -> {form_id} ;
- $fname = s/([^a-zA-Z0-9_])/_/g ;
+ $fname =~ s/([^a-zA-Z0-9_])/_/g ;
return qq{
-function epform_validate()
+function epform_validate_$fname()
{
var msgs = new Array ;
var fail = 0 ;
@@ -647,6 +646,7 @@
if (i)
alert (msgs.join('\\n')) ;
+ return !i ;
}
} ;
}
@@ -796,6 +796,97 @@
bar => 'baz',
baz => 49,
fnord => 1.2 };
+
+=head1 Example
+
+This example simply validates the form input when you hit submit.
+If your input is correct, the form is redisplay with your input,
+otherwise the error message is shown. If you turn off JavaScript
+the validation is still done one the server-side. Any validation
+for which no JavaScript validation is defined (like regex matches),
+only the server-side validation is performed.
+
+
+ <html>
+ <head>
+ [-
+
+ use Embperl::Form::Validate ;
+
+ $epf = Embperl::Form::Validate -> new (
+ [
+ [
+ -key => 'name',
+ -name => 'Name',
+ required => 1,
+ length_min => 4,
+ ],
+ [
+ -key => 'id',
+ -name => 'Id',
+ -type => 'Number',
+ gt => 0,
+ lt => 10,
+ ],
+ [
+ -key => 'email',
+ -msg => 'This is not a valid E-Mail address',
+ must_contain_one_of => '@.',
+ matches_regex => '..+@..+\\...+',
+ length_min => 8,
+ ],
+ [
+ -key => 'msg',
+ -name => 'Message',
+ emptyok => 1,
+ length_min => 10,
+ ]
+ ]) ;
+
+ if ($fdat{check})
+ {
+ $errors = $epf -> validate_messages ;
+ }
+
+ -]
+ <script>
+ [+ do { local $escmode = 0 ; $epf -> get_script_code } +]
+ </script>
+ </head>
+ <body>
+
+ <h1>Embperl Example - Input Form Validation</h1>
+
+ [$if @$errors $]
+ <h3>Please correct the following errors</h3>
+ [$foreach $e (@$errors)$]
+ <font color="red">[+ $e +]</font><br>
+ [$endforeach$]
+ [$else$]
+ <h3>Please enter your data</h3>
+ [$endif$]
+
+ <form action="formvalidation.htm" method="GET" onSubmit="return
epform_validate_forms_0_()">
+ <table>
+ <tr><td><b>Name</b></td> <td><input type="text" name="name"></td></tr>
+ <tr><td><b>Id (1-9)</b></td> <td><input type="text" name="id"></td></tr>
+ <tr><td><b>E-Mail</b></td> <td><input type="text" name="email"></td></tr>
+ <tr><td><b>Message</b></td> <td><input type="text" name="msg"></td></tr>
+ <tr><td colspan=2><input type="submit" name="check" value="send"></td></tr>
+ </table>
+ </form>
+
+
+ <p><hr>
+
+ <small>Embperl (c) 1997-2002 G.Richter / ecos gmbh <a
href="http://www.ecos.de";>www.ecos.de</a></small>
+
+ </body>
+ </html>
+
+
+See also eg/x/formvalidation.htm
+
=head1 SEE ALSO
No revision
No revision
1.1.2.3 +99 -20 embperl/Embperl/Form/Validate/Attic/Default.pm
Index: Default.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate/Attic/Default.pm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- Default.pm 7 Mar 2002 07:12:31 -0000 1.1.2.2
+++ Default.pm 8 Mar 2002 06:44:14 -0000 1.1.2.3
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Default.pm,v 1.1.2.2 2002/03/07 07:12:31 richter Exp $
+# $Id: Default.pm,v 1.1.2.3 2002/03/08 06:44:14 richter Exp $
#
###################################################################################
@@ -20,7 +20,7 @@
use strict;
use vars qw($VERSION %error_messages %script_functions %prefixes);
-$VERSION = q$Id: Default.pm,v 1.1.2.2 2002/03/07 07:12:31 richter Exp $;
+$VERSION = q$Id: Default.pm,v 1.1.2.3 2002/03/08 06:44:14 richter Exp $;
%script_functions = ();
%prefixes = ();
@@ -29,8 +29,8 @@
(
de =>
{
- validate_required => 'Bitte Felde %0 ausf�llen',
- validate_eq => 'Falscher Inhalt \'%1\' des Feldes %0: Erwartet wird \'%2\'',
+ validate_required => 'Bitte Feld "%0" ausf�llen',
+ validate_eq => 'Falscher Inhalt "%1" des Feldes "%0": Erwartet wird "%2"',
validate_lt => '%0 mu� kleiner als %2 sein',
validate_gt => '%0 mu� gr��er als %2 sein',
validate_le => '%0 mu� kleiner oder gleich wie %2 sein',
@@ -39,30 +39,30 @@
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_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\'',
- validate_must_not_contain => 'Das Feld %0 darf folgende Zeichen nicht
enthalten: \'%2\''
+ validate_matches_regexp => 'Inhalt "%1" des Feldes %0 entspricht nicht dem
regul�ren Ausdruck /%2/',
+ 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"',
+ validate_must_not_contain => 'Das Feld %0 darf folgende Zeichen nicht
enthalten: "%2"'
},
en =>
{
validate_required => 'Please enter a value in %0',
- validate_eq => 'Wrong content \'%1\' of field %0: Expected \'%2\'',
+ validate_eq => 'Wrong content "%1" of field %0: Expected "%2"',
validate_lt => '%0 must be less then %2',
validate_gt => '%0 must be greater then %2',
validate_le => '%0 must be less or equal then %2',
validate_ge => '%0 must be greater or equal then %2',
- validate_ne => 'Wrong content \'%1\' of field %0: Expected not \'%2\'',
+ validate_ne => 'Wrong content "%1" of field %0: Expected not "%2"',
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_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\'',
- validate_must_not_contain => 'Field %0 must not contain the following
characters: \'%2\''
+ validate_matches_regexp => 'Field %0 doesn"t 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"',
+ validate_must_not_contain => 'Field %0 must not contain the following
characters: "%2"'
}
);
@@ -119,7 +119,7 @@
{
my ($self, $arg, $pref) = @_ ;
- return ('!obj.value', ['validate_required']) ;
+ return ('obj.value', ['validate_required']) ;
}
# --------------------------------------------------------------
@@ -137,7 +137,7 @@
{
my ($self, $arg, $pref) = @_ ;
- return ('!obj.value') ;
+ return ('obj.value') ;
}
# --------------------------------------------------------------
@@ -173,7 +173,7 @@
{
my ($self, $arg, $pref) = @_ ;
- return ("obj.value < '$arg'", ['validate_gt', "+'obj.value'+", $arg]) ;
+ return ("obj.value > '$arg'", ['validate_gt', "+'obj.value'+", $arg]) ;
}
# --------------------------------------------------------------
@@ -187,6 +187,15 @@
# --------------------------------------------------------------
+sub getscript_lt
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value < '$arg'", ['validate_lt', "+'obj.value'+", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_ge
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -196,6 +205,15 @@
# --------------------------------------------------------------
+sub getscript_ge
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value >= '$arg'", ['validate_ge', "+'obj.value'+", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_le
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -203,6 +221,14 @@
return $value le $arg ? undef : ['validate_le', $value, $arg] ;
}
+# --------------------------------------------------------------
+
+sub getscript_le
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value <= '$arg'", ['validate_gt', "+'obj.value'+", $arg]) ;
+ }
# --------------------------------------------------------------
@@ -215,6 +241,15 @@
# --------------------------------------------------------------
+sub getscript_ne
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value != '$arg'", ['validate_gt', "+'obj.value'+", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_length_max
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -224,6 +259,15 @@
# --------------------------------------------------------------
+sub getscript_length_max
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value.length <= $arg", ['validate_length_max',
"'+obj.value.length+'", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_length_min
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -237,7 +281,7 @@
{
my ($self, $arg, $pref) = @_ ;
- return ("obj.value.length < $arg", ['validate_length_min',
"'+obj.value.length+'", $arg]) ;
+ return ("obj.value.length >= $arg", ['validate_length_min',
"'+obj.value.length+'", $arg]) ;
}
# --------------------------------------------------------------
@@ -251,6 +295,15 @@
# --------------------------------------------------------------
+sub getscript_length_eq
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value.length == $arg", ['validate_length_eq',
"'+obj.value.length+'", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_matches_regex
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -285,6 +338,14 @@
return ($value =~ /^[$moc]$/) ? undef : ['validate_must_only_contain', $value,
$moc] ;
}
+# --------------------------------------------------------------
+
+sub getscript_must_only_contain
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value.search(/^[$arg]*$/) >= 0", ['validate_must_only_contain',
"'+obj.value+'", $arg]) ;
+ }
# --------------------------------------------------------------
@@ -296,6 +357,14 @@
return ($value !~ /[$mnc]/) ? undef : ['validate_must_only_contain', $value,
$mnc] ;
}
+# --------------------------------------------------------------
+
+sub getscript_must_not_contain
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value.search(/[$arg]/) == -1", ['validate_must_not_contain',
"'+obj.value+'", $arg]) ;
+ }
# --------------------------------------------------------------
@@ -307,6 +376,16 @@
return ($value =~ /[$mcoo]/) ? undef : ['validate_must_only_contain', $value,
$mcoo] ;
}
+# --------------------------------------------------------------
+
+sub getscript_must_contain_one_of
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value.search(/[$arg]/) >= 0", ['validate_must_contain_one_of',
"'+obj.value+'", $arg]) ;
+ }
+
+# --------------------------------------------------------------
1 ;
1.1.2.3 +56 -2 embperl/Embperl/Form/Validate/Attic/Number.pm
Index: Number.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate/Attic/Number.pm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- Number.pm 7 Mar 2002 07:12:31 -0000 1.1.2.2
+++ Number.pm 8 Mar 2002 06:44:14 -0000 1.1.2.3
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Number.pm,v 1.1.2.2 2002/03/07 07:12:31 richter Exp $
+# $Id: Number.pm,v 1.1.2.3 2002/03/08 06:44:14 richter Exp $
#
###################################################################################
@@ -20,7 +20,7 @@
use base qw(Embperl::Form::Validate::Default);
my
-$VERSION = q$Id: Number.pm,v 1.1.2.2 2002/03/07 07:12:31 richter Exp $;
+$VERSION = q$Id: Number.pm,v 1.1.2.3 2002/03/08 06:44:14 richter Exp $;
my %error_messages =
(
@@ -67,6 +67,15 @@
# --------------------------------------------------------------
+sub getscript_eq
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value == $arg", ['validate_eq', "+'obj.value'+", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_gt
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -76,6 +85,15 @@
# --------------------------------------------------------------
+sub getscript_gt
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value > $arg", ['validate_gt', "+'obj.value'+", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_lt
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -85,6 +103,15 @@
# --------------------------------------------------------------
+sub getscript_lt
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value < $arg", ['validate_lt', "+'obj.value'+", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_ge
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -94,6 +121,15 @@
# --------------------------------------------------------------
+sub getscript_ge
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value >= $arg", ['validate_ge', "+'obj.value'+", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_le
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
@@ -104,11 +140,29 @@
# --------------------------------------------------------------
+sub getscript_le
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value <= $arg", ['validate_le', "+'obj.value'+", $arg]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_ne
{
my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
return $value != $arg ? undef : ['validate_ne', $value, $arg] ;
+ }
+
+# --------------------------------------------------------------
+
+sub getscript_ne
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ("obj.value != $arg", ['validate_ne', "+'obj.value'+", $arg]) ;
}
No revision
No revision
1.4.6.1 +3 -0 embperl/eg/README
Index: README
===================================================================
RCS file: /home/cvs/embperl/eg/README,v
retrieving revision 1.4
retrieving revision 1.4.6.1
diff -u -r1.4 -r1.4.6.1
--- README 31 Aug 1998 10:02:25 -0000 1.4
+++ README 8 Mar 2002 06:44:14 -0000 1.4.6.1
@@ -33,6 +33,9 @@
input.htm a input and confirmation form (including error checking),
which data will be send via mail
+formvalidation.htm shows how to use the formvalidation feature new
+ in Embperl 2.0b6
+
neu.htm this example shows many of the feature of Embperl, as
embedding various code, conditional processing and form
management (It's in German but I think it can be understand
No revision
No revision
1.1.2.1 +91 -0 embperl/eg/x/Attic/formvalidation.htm
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
