richter 02/03/05 07:59:20
Modified: Embperl/Form Tag: Embperl2c Validate.pm
Log:
form validation
Revision Changes Path
No revision
No revision
1.1.2.5 +160 -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.4
retrieving revision 1.1.2.5
diff -u -r1.1.2.4 -r1.1.2.5
--- Validate.pm 2 Mar 2002 00:46:16 -0000 1.1.2.4
+++ Validate.pm 5 Mar 2002 15:59:20 -0000 1.1.2.5
@@ -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.4 2002/03/02 00:46:16 richter Exp $
+# $Id: Validate.pm,v 1.1.2.5 2002/03/05 15:59:20 richter Exp $
#
###################################################################################
@@ -20,7 +20,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = q$Id: Validate.pm,v 1.1.2.4 2002/03/02 00:46:16 richter Exp $;
+$VERSION = q$Id: Validate.pm,v 1.1.2.5 2002/03/05 15:59:20 richter Exp $;
=head1 NAME
@@ -115,7 +115,7 @@
=cut
-sub new # $self, \%frules, [$form_id,] [, \%messages ]
+sub new # $self, \@frules, [$form_id,] [, \%messages ]
{
my $invokedby = shift;
my $class = ref($invokedby) || $invokedby;
@@ -127,7 +127,7 @@
form_id => $form_id || 'forms[0]', # The name (probably better
# XPath) of the HTML form
frules => $frules, # \%frules
- rules => new Embperl::Form::Validate::Rules($frules), # A new rules
object
+ #rules => new Embperl::Form::Validate::Rules($frules), # A new
rules object
msgmod => $msginstance, # A new messages object
default_language => 'en',
#@_
@@ -186,6 +186,7 @@
=cut
+=pod
sub validate # $self, \%fdat, \%pref
{
my $self = shift;
@@ -255,6 +256,160 @@
\%failed) :
undef);
}
+=cut
+
+sub loadtype
+ {
+ my ($self, $type) = @_ ;
+ my $type = shift;
+
+ $type ||= 'Default';
+ $type = 'Embperl::Form::Validate::Rules::'.$type
+ unless $type =~ m!(::|/)!;
+
+ eval "require $type;";
+ die 'Died inside '.__PACKAGE__.'::loadtype::eval: '.$@ if $@;
+ return $type;
+ }
+
+
+sub newtype
+ {
+ my ($self, $type) = @_ ;
+ my $type = shift;
+ my $obj = $self -> {typeobjs}{$type} ;
+ return $obj if ($obj) ;
+
+ $self -> loadtype ($type) ;
+
+ $obj = $self -> {typeobjs}{$type} = $type -> new ;
+
+ return $obj ;
+ }
+
+
+
+sub validate_rules
+ {
+ my ($self, $fdat, $pref) = @_ ;
+
+ my %param ;
+ my $type ;
+ my $typeobj ;
+
+ my $frules = $self->{frules};
+ while ($i < @$frules)
+ {
+ my $key = $frules -> [$i++] ;
+ if (ref $key eq 'ARRAY')
+ {
+ my $fail = $self -> validate_rules ($key, $fdat, $pref, $result) ;
+ return $fail if ($fail) ;
+ }
+ elsif (ref $key eq 'CODE')
+ {
+ foreach my $name (@$names)
+ {
+ $status = &$key($self, $name, $fdat -> {$name}, $frules, \$i,
$fdat, $pref) ;
+ last if (!$status) ;
+ }
+ }
+ elsif ($key =~ /^-(.*?)$/)
+ {
+ if ($1 eq 'name')
+ {
+ $name = $frules->[$i++] ;
+ $type = 'Default' ;
+ $typeobj = $self -> newtype ($type) ;
+ }
+ elsif ($1 eq 'type')
+ {
+ $type = $frules->[$i++] ;
+ $typeobj = $self -> newtype ($type) ;
+ $status = $typeobj -> validate ($self, $name, $fdat -> {$name},
$frules, \$i, $fdat, $pref) ;
+ }
+ else
+ {
+ $param{$1} = 1 ;
+ }
+ }
+ else
+ {
+ foreach my $name (@$names)
+ {
+ $status = $type -> $key ($self, $name, $fdat -> {$name}, $frules,
\$i, $fdat, $pref) ;
+ last if (!$status) ;
+ }
+ }
+
+ if ($status)
+ {
+ push @$result, $status
+ last if (!$param{cont})
+ }
+ }
+ return $param{fail} ;
+ }
+
+
+
+
+sub validate
+ {
+ my ($self, $fdat, $pref) = @_ ;
+
+ my @result ;
+ $self -> validate_rules ($self->{frules}, $fdat, $pref, \@result) ;
+
+ return \@result ;
+ }
+
+
+
+
+=pod
+
+ [
+ -name => 'lang',
+ -fail,
+ required,
+ length_max => 5,
+
+ -name => 'xxx',
+ -type => 'date',
+ emptyok,
+
+
+ -name => ['foo', 'bar']
+ \&mysub,
+
+=cut
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
=head2 $epf->generate_error_message($error,$language);
@@ -289,6 +444,7 @@
my $self = shift;
my ($id, $key, $name, $should, $is, $value, $msgs) = @{shift()};
my $language = shift;
+
# Form-local error message
my $local_msg = $self->{frules}->{$key}->{messages}->{$language}->{$id};
# Embperl::Form::Validate::Messages' error message
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
