Author: richter
Date: Sun Aug 26 14:00:23 2012
New Revision: 1377443
URL: http://svn.apache.org/viewvc?rev=1377443&view=rev
Log:
Docs & Enhancements for Embperl::Form::Validate
Modified:
perl/embperl/trunk/Embperl/Form.pm
perl/embperl/trunk/Embperl/Form/Validate.pm
perl/embperl/trunk/Embperl/Form/Validate/EMail.pm
perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm
Modified: perl/embperl/trunk/Embperl/Form.pm
URL:
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form.pm?rev=1377443&r1=1377442&r2=1377443&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form.pm (original)
+++ perl/embperl/trunk/Embperl/Form.pm Sun Aug 26 14:00:23 2012
@@ -103,7 +103,7 @@ sub sub_new
if ($toplevel)
{
- my $epf = $self -> {validate} = Embperl::Form::Validate -> new
($validate_rules, $self -> {formname}) if ($self -> {validate_rules}) ;
+ my $epf = $self -> {validate} = Embperl::Form::Validate -> new
($validate_rules, $self -> {formname}, $options -> {language}, $options ->
{charset}) if ($self -> {validate_rules}) ;
$self -> add_code_at_bottom ($epf -> get_script_code) ;
}
@@ -607,7 +607,18 @@ sub prepare_fdat
sub validate
{
+ my ($self, $fdat, $pref, $epreq) = @_ ;
+
+ my $validate = $self -> {validate} ;
+ my $result = $validate -> validate ($fdat, $pref, $epreq) ;
+ my @msgs ;
+ foreach my $err (@$result)
+ {
+ my $msg = $validate -> error_message ($err, $pref, $epreq) ;
+ push @msgs, $msg ;
+ }
+ return ($result, \@msgs) ;
}
@@ -1099,6 +1110,14 @@ will deafult all C<textarea> controls to
it will set the default class for the labels of all controls to
myclass and not to wrap the text.
+=item * language
+
+Language setting is used for Embperl::Form::Validate, e.g. 'en' or 'de'
+
+=item * charset
+
+Charset setting is used for Embperl::Form::Validate, e.g. 'utf-8'
+
=item * valign
valign for control cells. Defaults to 'top' .
@@ -1139,6 +1158,8 @@ overwrite the method get_datasrc_package
=head2 layout
+=head2 validate
+
=head2 show
=head2 convert_label
Modified: perl/embperl/trunk/Embperl/Form/Validate.pm
URL:
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate.pm?rev=1377443&r1=1377442&r2=1377443&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate.pm Sun Aug 26 14:00:23 2012
@@ -20,6 +20,8 @@ package Embperl::Form::Validate;
use strict;
use vars qw($VERSION);
+use Encode ;
+
$VERSION = '2.0.0' ;
=head1 NAME
@@ -396,7 +398,17 @@ sub build_message
$txt ||= "Missing Message $id: %0 %1 %2 %3" ;
$id = $param -> [0] ;
$param -> [0] = $name ;
- $txt =~ s/%(\d+)/$param->[$1]/g ;
+ my @param ;
+ if ($charset)
+ {
+ @param = map { Encode::encode($charset, $_) } @$param ;
+ }
+ else
+ {
+ @param = @$param ;
+ }
+
+ $txt =~ s/%(\d+)/$param[$1]/g ;
$param -> [0] = $id ;
return $txt ;
@@ -578,7 +590,7 @@ sub gather_script_code
if ($msgparam && !$break)
{
my $txt = $self -> build_message ($msgparam -> [0], $key,
$nametxt, $msgtxt, $msgparam, $typeobj, $pref, $epreq) ;
- $setmsg = "msgs[i++]='$txt';"
+ $setmsg = "ids[i] = '$key' ; msgs[i++]='$txt';"
}
if (!ref $key)
{
@@ -652,9 +664,10 @@ sub get_script_code
return qq{
-function epform_validate_$fname()
+function epform_validate_$fname(return_msgs, failed_class)
{
var msgs = new Array ;
+ var ids = new Array ;
var fail = 0 ;
var i = 0 ;
var obj ;
@@ -663,6 +676,29 @@ function epform_validate_$fname()
$script ;
}
while (0) ;
+ var firstelem ;
+ if (failed_class)
+ {
+ var key ;
+ for (key in ids)
+ {
+ var elem = document.$fname\[ids[key]\] ;
+ if (elem)
+ {
+ var eclass = elem.getAttribute('class') ;
+ elem.setAttribute ('class', eclass + ' ' + failed_class) ;
+ elem.setAttribute ('title', msgs[key]) ;
+ if (!firstelem)
+ firstelem = elem ;
+ }
+ }
+ }
+ if (firstelem)
+ firstelem.focus() ;
+
+ if (return_msgs)
+ return msgs ;
+
if (i)
alert (msgs.join('\\n')) ;
@@ -747,6 +783,10 @@ Input must be a floating point number.
Input must be a integer number.
+=item PosInteger
+
+Input must be a integer number and greater or equal zero.
+
=item TimeHHMM
Input must be the time in the format hh::mm
@@ -755,6 +795,10 @@ Input must be the time in the format hh:
Input must be the time in the format hh::mm:ss
+=item TimeValue
+
+Input must be a number followed by s, m, h, d or w.
+
=item EMail
Input must be a valid email address including a top level domain
@@ -777,6 +821,11 @@ Input must be an ip-address and network
Input must be an ip-address or an fqdn (host.domain)
+=item select
+
+This used together with required and causes Embperl::Form::Validate
+to test of a selected index != 0 instead of a non empty input.
+
=back
Modified: perl/embperl/trunk/Embperl/Form/Validate/EMail.pm
URL:
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/EMail.pm?rev=1377443&r1=1377442&r2=1377443&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/EMail.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/EMail.pm Sun Aug 26 14:00:23 2012
@@ -79,7 +79,7 @@ sub getscript_validate
{
my ($self, $arg, $pref) = @_ ;
- return ('((obj.value.search(/^[^ <>()@¡-ÿ]+@[^
<>()@¡-ÿ]+\.[a-zA-Z]{2,4}$/) >= 0) &&
(obj.value.search(/@(\.|.*(\.\.|@))|mailto:/i) < 0))',
+ return ('((obj.value.search(/^[^ <>()@\x80-\xff]+@[^
<>()@\x80-\xff]+\.[a-zA-Z]{2,4}$/) >= 0) &&
(obj.value.search(/@(\.|.*(\.\.|@))|mailto:/i) < 0))',
['validate_email', "'+obj.value+'"]) ;
}
Modified: perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm
URL:
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm?rev=1377443&r1=1377442&r2=1377443&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/PosInteger.pm Sun Aug 26 14:00:23
2012
@@ -19,6 +19,37 @@ package Embperl::Form::Validate::PosInte
use base qw(Embperl::Form::Validate::Integer);
+my %error_messages =
+(
+ de =>
+ {
+ validate_pos_number => '%0 muß eine Zahl größer oder gleich Null sein',
+ },
+
+ 'de.utf-8' =>
+ {
+ validate_pos_number => '%0 muà eine Zahl gröÃer oder gleich Null
sein',
+ },
+
+ en =>
+ {
+ validate_pos_number => '%0 must be a number greater or equal zero',
+ }
+ );
+
+# --------------------------------------------------------------
+
+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) ;
+ }
+
+
+# --------------------------------------------------------------
# --------------------------------------------------------------
@@ -26,7 +57,7 @@ sub validate
{
my ($self, $key, $value, $fdat, $pref) = @_ ;
- return $value =~ /^\s*[0-9+][0-9]*\s*$/ ? undef : ['validate_number',
$value] ;
+ return $value =~ /^\s*[0-9+][0-9]*\s*$/ ? undef : ['validate_pos_number',
$value] ;
}
# --------------------------------------------------------------
@@ -35,7 +66,7 @@ sub getscript_validate
{
my ($self, $arg, $pref) = @_ ;
- return ('obj.value.search(/^\s*[0-9+][0-9]*\s*$/) >= 0',
['validate_number', "'+obj.value+'"]) ;
+ return ('obj.value.search(/^\s*[0-9+][0-9]*\s*$/) >= 0',
['validate_pos_number', "'+obj.value+'"]) ;
}
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscr...@perl.apache.org
For additional commands, e-mail: embperl-cvs-h...@perl.apache.org
