richter 02/03/06 07:24:22
Modified: Embperl/Form Tag: Embperl2c Validate.pm
Embperl/Form/Validate/Rules Tag: Embperl2c Default.pm
eg/web/db Tag: Embperl2c addsel.epl
Log:
form validation
Revision Changes Path
No revision
No revision
1.1.2.7 +218 -23 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.6
retrieving revision 1.1.2.7
diff -u -r1.1.2.6 -r1.1.2.7
--- Validate.pm 5 Mar 2002 21:55:23 -0000 1.1.2.6
+++ Validate.pm 6 Mar 2002 15:24:22 -0000 1.1.2.7
@@ -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.6 2002/03/05 21:55:23 richter Exp $
+# $Id: Validate.pm,v 1.1.2.7 2002/03/06 15:24:22 richter Exp $
#
###################################################################################
@@ -20,7 +20,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = q$Id: Validate.pm,v 1.1.2.6 2002/03/05 21:55:23 richter Exp $;
+$VERSION = q$Id: Validate.pm,v 1.1.2.7 2002/03/06 15:24:22 richter Exp $;
=head1 NAME
@@ -349,7 +349,7 @@
$typeobj = $self -> newtype ($type) ;
foreach my $k (@$keys)
{
- $status = $typeobj -> validate ($k, $fdat -> {$name}, $frules,
\$i, $fdat, $pref) ;
+ $status = $typeobj -> validate ($k, $fdat -> {$k}, $frules, \$i,
$fdat, $pref) ;
last if (!$status) ;
}
}
@@ -372,24 +372,8 @@
{
if (@$status)
{
- my $txt ;
my $id = $status -> [0] ;
-
- my $n = $key ;
- $n = $frules -> [$name] if ($name) ;
- $status -> [0] = ref $n ? ($n -> {$language} || $n ->
{$default_language} || (each %$n)[1] || $key):$n ;
-
- if ($msg)
- {
- my $m = $frules -> [$msg] ;
- $txt = ref $m ? ($m -> {$language} || $m -> {$default_language}
|| (each %$m)[1] || undef):$m ;
- }
- else
- {
- $txt = $typeobj -> getmsg ($id, $language, $default_language) ;
- }
-
- push @$result, { id => $id, key => $key, ($txt?(msg => $txt):()),
param => $status} ;
+ push @$result, { typeobj => $typeobj, id => $id, key => $key,
($name?(name => $frules -> [$name]):()), ($msg?(msg => $frules -> [$msg]):()), param
=> $status} ;
}
last if (!$param{cont})
}
@@ -411,9 +395,51 @@
}
+sub build_message
+ {
+ my ($self, $id, $key, $name, $msg, $param, $typeobj, $pref, $epreq) = @_ ;
+
+ my $language = $pref -> {language} ;
+ my $default_language = $pref -> {default_language} ;
+ my $txt ;
+
+ my $name ||= $key ;
+ if (ref $name eq 'ARRAY')
+ {
+ my @names ;
+ foreach my $n (@$name)
+ {
+ push @names, ref $n ? ($n -> {$language} || $n -> {$default_language}
|| (each %$n)[1] || $key):$n ;
+ }
+ $name = join (', ', @names) ;
+ }
+ else
+ {
+ $name = ref $name ? ($name -> {$language} || $name -> {$default_language}
|| (each %$name)[1] || $key):$name ;
+ }
+
+ if ($msg)
+ {
+ $txt = ref $msg ? ($msg -> {$language} || $msg -> {$default_language} ||
(each %$msg)[1] || undef):$msg ;
+ }
+ else
+ {
+ $txt = $typeobj -> getmsg ($id, $language, $default_language) ;
+ }
+ $txt = $epreq -> gettext($id) if (!$txt && $epreq) ;
+ $txt ||= "Missing Message $id: %0 %1 %2 %3" ;
+ my $id = $param -> [0] ;
+ $param -> [0] = $name ;
+ $txt =~ s/%(\d+)/$param->[$1]/g ;
+ $param -> [0] = $id ;
+
+ return $txt ;
+ }
+
+
sub error_messages
{
- my ($self, $fdat, $pref) = @_ ;
+ my ($self, $fdat, $pref, $epreq) = @_ ;
my $result = $self -> validate ($fdat, $pref) ;
return [] if (!@$result) ;
@@ -421,8 +447,7 @@
my @msgs ;
foreach my $err (@$result)
{
- my $msg = $err -> {msg} || 'Unknown error in %1: is %1 should %2' ;
- $msg =~ s/%(\d+)/$err->{param}[$1]/g ;
+ my $msg = $self -> build_message ($err -> {id}, $err -> {key}, $err ->
{name}, $err -> {msg}, $err -> {param}, $err -> {typeobj}, $pref, $epreq) ;
push @msgs, $msg ;
}
@@ -430,6 +455,176 @@
}
+
+sub gather_script_code
+ {
+ my ($self, $frules, $pref, $epreq) = @_ ;
+
+ my %param ;
+ my $type ;
+ my $typeobj ;
+ my $i ;
+ my $keys = [] ;
+ my $key ;
+ my $status ;
+ my $name ;
+ my $msg ;
+ my $msgparam ;
+ my $language = $pref -> {language} ;
+ my $default_language = $pref -> {default_language} || 'en' ;
+ my $scriptcode = $self -> {scriptcode} ||= {} ;
+ my $script = '' ;
+ my $form = $self -> {form_id} ;
+
+ while ($i < @$frules)
+ {
+ my $method ;
+ my $action = $frules -> [$i++] ;
+ if (ref $action eq 'ARRAY')
+ {
+ $script .= $self -> gather_script_code ($action, $pref, $epreq) ;
+ }
+ elsif (ref $action eq 'CODE')
+ {
+ }
+ elsif ($action =~ /^-(.*?)$/)
+ {
+ if ($1 eq 'key')
+ {
+ $key = $frules->[$i++] ;
+ $keys = ref $key?$key:[$key] ;
+ $type = 'Default' ;
+ $typeobj = $self -> newtype ($type) ;
+ $name = undef ;
+ $msg = undef ;
+ }
+ if ($1 eq 'name')
+ {
+ $name = $i++ ;
+ }
+ if ($1 eq 'msg')
+ {
+ $msg = $i++ ;
+ }
+ elsif ($1 eq 'type')
+ {
+ $type = $frules->[$i++] ;
+ $typeobj = $self -> newtype ($type) ;
+ $method = 'getscript_validate' ;
+ }
+ else
+ {
+ $param{$1} = 1 ;
+ }
+ }
+ else
+ {
+ $method = 'getscript_' . $action ;
+ }
+
+ if ($method)
+ {
+ my $code ;
+ my $ret ;
+ my $k = "$type*$action" ;
+ if (!exists ($scriptcode -> {$k}))
+ {
+ if ($typeobj -> can ($method))
+ {
+ my $j = $i ;
+ ($code, $msgparam) = $typeobj -> $method ($frules, \$i, $pref) ;
+ $scriptcode -> {$k} = [$code, $msgparam, $i - $j] ;
+ }
+ else
+ {
+ $code = '' ;
+ $scriptcode -> {$k} = '' ;
+ }
+ }
+ else
+ {
+ if ($scriptcode -> {$k})
+ {
+ $code = $scriptcode -> {$k}[0] ;
+ $msgparam = $scriptcode -> {$k}[1] ;
+ $i += $scriptcode -> {$k}[2] ;
+ }
+ }
+
+ if ($code)
+ {
+ my $nametxt = $name?$frules -> [$name]:undef ;
+ my $msgtxt = $msg?$frules -> [$msg]:undef ;
+ my $setmsg = '' ;
+ if ($msgparam)
+ {
+ my $txt = $self -> build_message ($msgparam -> [0], $key,
$nametxt, $msgtxt, $msgparam, $typeobj, $pref, $epreq) ;
+ $setmsg = "msgs[i++]='$txt';"
+ }
+ if (!ref $key)
+ {
+
+ $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 .= " $setmsg " .
($param{fail}?'fail=1;break;':($param{cont}?'':'break;')) . "\n" ;
+ foreach my $k (@$keys)
+ {
+ $script .= "}" ;
+ }
+ }
+ }
+ }
+ }
+ if ($script)
+ {
+ return qq{
+do {
+$script
+} while (0) ; if (fail) break ;
+} ;
+ }
+ return '' ;
+ }
+
+
+
+
+sub get_script_code
+ {
+ my ($self, $pref, $epreq) = @_ ;
+
+ $pref ||= {} ;
+ $pref -> {language} ||= $epreq -> param -> language if ($epreq) ;
+
+ my $script ;
+ $script = $self -> gather_script_code ($self->{frules}, $pref, $epreq) ;
+
+ return qq{
+
+function epform_validate()
+ {
+ var msgs = new Array ;
+ var fail = 0 ;
+ var i = 0 ;
+ var obj ;
+
+ do {
+ $script ;
+ }
+ while (0) ;
+ if (i)
+ alert (msgs.join('\\n')) ;
+
+ }
+} ;
+ }
=pod
No revision
No revision
1.1.2.4 +41 -2 embperl/Embperl/Form/Validate/Rules/Attic/Default.pm
Index: Default.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate/Rules/Attic/Default.pm,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -u -r1.1.2.3 -r1.1.2.4
--- Default.pm 5 Mar 2002 21:55:23 -0000 1.1.2.3
+++ Default.pm 6 Mar 2002 15:24:22 -0000 1.1.2.4
@@ -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.3 2002/03/05 21:55:23 richter Exp $
+# $Id: Default.pm,v 1.1.2.4 2002/03/06 15:24:22 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.3 2002/03/05 21:55:23 richter Exp $;
+$VERSION = q$Id: Default.pm,v 1.1.2.4 2002/03/06 15:24:22 richter Exp $;
%script_functions = ();
%prefixes = ();
@@ -29,6 +29,7 @@
(
de =>
{
+ validate_required => 'Bitte Felde %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',
@@ -47,6 +48,7 @@
en =>
{
+ validate_required => 'Please enter a value in %0',
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',
@@ -113,6 +115,15 @@
# --------------------------------------------------------------
+sub getscript_required
+ {
+ my ($self, $frules, $i, $pref) = @_ ;
+
+ return ('!obj.value', ['validate_required']) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_emptyok
{
my ($self, $key, $value, $frules, $i, $fdat, $pref) = @_ ;
@@ -122,6 +133,15 @@
# --------------------------------------------------------------
+sub getscript_emptyok
+ {
+ my ($self, $frules, $i, $pref) = @_ ;
+
+ return ('!obj.value') ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_eq
{
my ($self, $key, $value, $frules, $i, $fdat, $pref) = @_ ;
@@ -132,6 +152,16 @@
# --------------------------------------------------------------
+sub getscript_eq
+ {
+ my ($self, $frules, $i, $pref) = @_ ;
+
+ my $should = $frules -> [$$i++] ;
+ return ("obj.value == '$should'", ['validate_eq', "+'obj.value'+", $should]) ;
+ }
+
+# --------------------------------------------------------------
+
sub validate_gt
{
my ($self, $key, $value, $frules, $i, $fdat, $pref) = @_ ;
@@ -203,6 +233,15 @@
# --------------------------------------------------------------
+sub getscript_length_min
+ {
+ my ($self, $frules, $i, $pref) = @_ ;
+
+ my $should = $frules -> [$$i++] ;
+ return ("obj.value.length < $should", ['validate_length_min',
"'+obj.value.length+'", $should]) ;
+ }
+
+# --------------------------------------------------------------
sub validate_length_eq
{
my ($self, $key, $value, $frules, $i, $fdat, $pref) = @_ ;
No revision
No revision
1.1.2.4 +20 -10 embperl/eg/web/db/Attic/addsel.epl
Index: addsel.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/Attic/addsel.epl,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -u -r1.1.2.3 -r1.1.2.4
--- addsel.epl 1 Mar 2002 15:29:34 -0000 1.1.2.3
+++ addsel.epl 6 Mar 2002 15:24:22 -0000 1.1.2.4
@@ -5,22 +5,32 @@
$$langset -> Reset ;
while ($rec = $$langset -> Next)
{
- $rules{"category_$rec->{id}"} = {type => 'String', length_min => 5, emptyok =>
1, name => $rec -> {name}} ;
+ push @rules,
+ [
+ -key => "category_$rec->{id}",
+ -name => $rec -> {name},
+ 'emptyok',
+ length_min => 5
+ ] ;
+ push @keys, "category_$rec->{id}" ;
}
+
+
+
use Embperl::Form::Validate ;
-$epf = Embperl::Form::Validate -> new (\%rules) ;
+$epf = Embperl::Form::Validate -> new ([
+ -key => \@keys,
+ -name => { de => 'eine Kategorie', en =>
'one category' },
+ 'required',
+ @rules,
+ ]) ;
$Embperl::Form::Validate::objects{'addsel'} = $epf ;
-]
<script>
-[- ($a, $b) = $epf->sprint_scripting_code({Language => $r -> param -> language}) -]
-[+ do { local $escmode = 0 ; $a } +]
-function on_submit()
-{
-[+ do { local $escmode = 0 ; $b } +]
-}
+[+ do { local $escmode = 0 ; $epf -> get_script_code (undef, $r) } +]
</script>
[= addsel1 =]
@@ -33,9 +43,9 @@
</ul>
-<form action="[+ $r -> param -> uri +]" OnSubmit="[+ do { local $escmode = 0 ; $b
} +]">
+<form action="[+ $r -> param -> uri +]" OnSubmit="">
-<input type="button" onclick="on_submit()">
+<input type="button" onclick="epform_validate()"><br>
[= addsel2 =]<br>
[= addsel3 =]<br><br>
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
