richter 2002/07/02 03:39:16
Modified: . Tag: Embperl2c Changes.pod
Embperl/Form Tag: Embperl2c Validate.pm
Embperl/Form/Validate Tag: Embperl2c Default.pm
Log:
fix form validate
Revision Changes Path
No revision
No revision
1.129.4.85 +1 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.129.4.84
retrieving revision 1.129.4.85
diff -u -r1.129.4.84 -r1.129.4.85
--- Changes.pod 2 Jul 2002 10:15:47 -0000 1.129.4.84
+++ Changes.pod 2 Jul 2002 10:39:15 -0000 1.129.4.85
@@ -9,6 +9,7 @@
does under Embperl::Object.
- fixed typo in JavaScript code for Form::Validate
- fixed typo in Embperl::Mail reported by Axel Beckert.
+ - fixed small bugs in Embperl::Form::Validate test code reported by Axel
Beckert.
=head1 2.0b8 (BETA) 25. Juni 2002
No revision
No revision
1.1.2.11 +4 -4 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.10
retrieving revision 1.1.2.11
diff -u -r1.1.2.10 -r1.1.2.11
--- Validate.pm 8 Mar 2002 06:44:14 -0000 1.1.2.10
+++ Validate.pm 2 Jul 2002 10:39:16 -0000 1.1.2.11
@@ -64,7 +64,7 @@
print 'Validate: ' . ($result?'no':'yes');
# validate the form values and reaturn all error messages, if any
- my @errors = $epf->validate_messages($fdat, $pref);
+ my $errors = $epf->validate_messages($fdat, $pref);
# Get the code for a client-side form validation according to the
# rules given to new:
@@ -427,7 +427,7 @@
=head2 $epf -> validate_messages ($fdat, [ $pref ])
Validate the form content and returns the error messages
-if any. See L<validate> for details.
+as array ref if any. See L<validate> for details.
=cut
No revision
No revision
1.1.2.5 +28 -9 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.4
retrieving revision 1.1.2.5
diff -u -r1.1.2.4 -r1.1.2.5
--- Default.pm 1 Jul 2002 10:32:17 -0000 1.1.2.4
+++ Default.pm 2 Jul 2002 10:39:16 -0000 1.1.2.5
@@ -335,7 +335,8 @@
$moc =~ s/^\^(.)/$1^/;
$moc =~ s/^(.*)\]/\]$1/;
$moc =~ s/^(.*)-/-$1/;
- return ($value =~ /^[$moc]$/) ? undef : ['validate_must_only_contain', $value,
$moc] ;
+ $moc =~ s#/#\\/#;
+ return ($value =~ /^[$moc]*$/) ? undef : ['validate_must_only_contain', $value,
$moc] ;
}
# --------------------------------------------------------------
@@ -344,6 +345,10 @@
{
my ($self, $arg, $pref) = @_ ;
+ $arg =~ s/^\^(.)/$1^/;
+ $arg =~ s/^(.*)\]/\]$1/;
+ $arg =~ s/^(.*)-/-$1/;
+ $arg =~ s#/#\\/#;
return ("obj.value.search(/^[$arg]*\$/) >= 0", ['validate_must_only_contain',
"'+obj.value+'", $arg]) ;
}
@@ -351,10 +356,13 @@
sub validate_must_not_contain
{
- my ($self, $key, $value, $mnc, $fdat, $pref) = @_ ;
+ my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
- $mnc =~ s/^\^(.)/$1^/;
- return ($value !~ /[$mnc]/) ? undef : ['validate_must_only_contain', $value,
$mnc] ;
+ $arg =~ s/^\^(.)/$1^/;
+ $arg =~ s/^(.*)\]/\]$1/;
+ $arg =~ s/^(.*)-/-$1/;
+ $arg =~ s#/#\\/#;
+ return ($value !~ /[$arg]/) ? undef : ['validate_must_only_contain', $value,
$arg] ;
}
# --------------------------------------------------------------
@@ -363,6 +371,10 @@
{
my ($self, $arg, $pref) = @_ ;
+ $arg =~ s/^\^(.)/$1^/;
+ $arg =~ s/^(.*)\]/\]$1/;
+ $arg =~ s/^(.*)-/-$1/;
+ $arg =~ s#/#\\/#;
return ("obj.value.search(/[$arg]/) == -1", ['validate_must_not_contain',
"'+obj.value+'", $arg]) ;
}
@@ -370,10 +382,13 @@
sub validate_must_contain_one_of
{
- my ($self, $key, $value, $mcoo, $fdat, $pref) = @_ ;
+ my ($self, $key, $value, $arg, $fdat, $pref) = @_ ;
- $mcoo =~ s/^\^(.)/$1^/;
- return ($value =~ /[$mcoo]/) ? undef : ['validate_must_only_contain', $value,
$mcoo] ;
+ $arg =~ s/^\^(.)/$1^/;
+ $arg =~ s/^(.*)\]/\]$1/;
+ $arg =~ s/^(.*)-/-$1/;
+ $arg =~ s#/#\\/#;
+ return ($value =~ /[$arg]/) ? undef : ['validate_must_only_contain', $value,
$arg] ;
}
# --------------------------------------------------------------
@@ -382,6 +397,10 @@
{
my ($self, $arg, $pref) = @_ ;
+ $arg =~ s/^\^(.)/$1^/;
+ $arg =~ s/^(.*)\]/\]$1/;
+ $arg =~ s/^(.*)-/-$1/;
+ $arg =~ s#/#\\/#;
return ("obj.value.search(/[$arg]/) >= 0", ['validate_must_contain_one_of',
"'+obj.value+'", $arg]) ;
}
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]