Author: richter
Date: Mon Jun 10 05:39:14 2013
New Revision: 1491340
URL: http://svn.apache.org/r1491340
Log:
Validate for duration control
Added:
perl/embperl/trunk/Embperl/Form/Validate/Duration.pm
Modified:
perl/embperl/trunk/Embperl/Form/Control/duration.pm
Modified: perl/embperl/trunk/Embperl/Form/Control/duration.pm
URL:
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/duration.pm?rev=1491340&r1=1491339&r2=1491340&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/duration.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/duration.pm Mon Jun 10 05:39:14 2013
@@ -90,6 +90,20 @@ sub prepare_fdat
$fdat->{$name} = - $fdat{$name} if ($neg) ;
}
+# ---------------------------------------------------------------------------
+#
+# get_validate_auto_rules - get rules for validation, in case user did
+# not specify any
+#
+
+sub get_validate_auto_rules
+ {
+ my ($self, $req) = @_ ;
+
+ return [ $self -> {required}?(required => 1):(emptyok => 1), -type =>
'Duration' ] ;
+ }
+
+
1 ;
__EMBPERL__
Added: perl/embperl/trunk/Embperl/Form/Validate/Duration.pm
URL:
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/Duration.pm?rev=1491340&view=auto
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/Duration.pm (added)
+++ perl/embperl/trunk/Embperl/Form/Validate/Duration.pm Mon Jun 10 05:39:14
2013
@@ -0,0 +1,101 @@
+
+###################################################################################
+#
+# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de
+# Embperl - Copyright (c) 2008-2012 Gerald Richter
+#
+# 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 1382642 2012-09-10 05:33:29Z richter $
+#
+###################################################################################
+
+
+package Embperl::Form::Validate::Duration ;
+
+use base qw(Embperl::Form::Validate::Default);
+
+my %error_messages =
+(
+ de =>
+ {
+ validate_duration_long => 'Feld %0: "%1" ist keine gültige Zeitdauer.
Geben Sie die Dauer in der Form hh:mm oder als Minuten ein',
+ },
+
+ 'de.utf-8' =>
+ {
+ validate_duration_long => 'Feld %0: "%1" ist keine gültiges Zeitdauer.
Geben Sie die Dauer in der Form hh:mm oder als Minuten ein',
+ },
+
+ en =>
+ {
+ validate_duration_long => 'Field %0: "%1" isn\\\'t a valid duration.
Please enter the time as hh:mm or in minutes',
+ }
+ );
+
+# --------------------------------------------------------------
+
+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_duration_long', $value] ;
+ }
+ return undef ;
+ }
+ if($value =~ /^(\d\d):(\d\d)$/)
+ {
+ if ($1 < 0 || $1 > 23 ||
+ $2 < 0 || $2 > 59 )
+ {
+ return ['validate_duration_long', $value] ;
+ }
+ return undef ;
+ }
+
+ if($value =~ /^(\d+)$/)
+ {
+ if ($1 < 0)
+ {
+ return ['validate_duration_long', $value] ;
+ }
+ return undef ;
+ }
+
+ return ['validate_duration_long', $value] ;
+ }
+
+# --------------------------------------------------------------
+
+sub getscript_validate
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return ('(obj.value.search(/^\d?\d:\d\d:\d\d$/) >= 0) ||
(obj.value.search(/^\d?\d:\d\d$/) >= 0) ||
(obj.value.search(/^\s*[0-9+][0-9]*\s*$/) >= 0)', ['validate_duration_long',
"'+obj.value+'"]) ;
+ }
+
+
+1;
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscr...@perl.apache.org
For additional commands, e-mail: embperl-cvs-h...@perl.apache.org
