/[webpac2]/trunk/lib/WebPAC/Validate.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Validate.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 514 by dpavlin, Tue May 16 13:38:09 2006 UTC revision 515 by dpavlin, Tue May 16 15:23:05 2006 UTC
# Line 7  use blib; Line 7  use blib;
7    
8  use base 'WebPAC::Common';  use base 'WebPAC::Common';
9  use File::Slurp;  use File::Slurp;
10    use List::Util qw/first/;
11  use Data::Dumper;  use Data::Dumper;
12    
13  =head1 NAME  =head1 NAME
# Line 79  sub new { Line 80  sub new {
80                  my $fld = shift @d || $log->logdie("need field name in line $curr_line: $l");                  my $fld = shift @d || $log->logdie("need field name in line $curr_line: $l");
81    
82                  if (@d) {                  if (@d) {
83                          $v->{$fld}->{ref} = 'ARRAY';                          $v->{$fld} = \@d;
                         $v->{$fld}->{sf} = \@d;  
84                  } else {                  } else {
85                          $v->{$fld}->{ref} = '';                          $v->{$fld} = 1;
86                  }                  }
87    
88          }          }
# Line 94  sub new { Line 94  sub new {
94          $self ? return $self : return undef;          $self ? return $self : return undef;
95  }  }
96    
97    =head2 validate_errors
98    
99    Validate record and return errors
100    
101      my @errors = $validate->validate_errors( $rec );
102    
103    =cut
104    
105    sub validate_errors {
106            my $self = shift;
107    
108            my $log = $self->_get_logger();
109    
110            my $rec = shift || $log->logdie("validate_errors need record");
111    
112            $log->logdie("rec isn't HASH") unless (ref($rec) eq 'HASH');
113            $log->logdie("can't find validation rules") unless (my $r = $self->{rules});
114    
115            my @errors;
116    
117            $log->debug("rec = ", sub { Dumper($rec) }, "keys = ", keys %{ $rec });
118    
119            foreach my $f (keys %{ $rec }) {
120    
121                    next if (!defined($f) || $f eq '');
122    
123                    if (! defined($r->{$f})) {
124                            push @errors, "field '$f' shouldn't exists";
125                            next;
126                    }
127    
128                    if (ref($rec->{$f}) ne 'ARRAY') {
129                            push @errors, "field '$f' isn't repetable, probably bug in parsing input data";
130                            next;
131                    }
132    
133                    foreach my $v (@{ $rec->{$f} }) {
134                            # can we have subfields?
135                            if (ref($r->{$f}) eq 'ARRAY') {
136                                    # are values hashes? (has subfields)
137                                    if (ref($v) ne 'HASH') {
138                                            push @errors, "$f has value without subfields: $v";
139                                            next;
140                                    } else {
141                                            foreach my $sf (keys %{ $v }) {
142                                                    # permited subfield?
143                                                    if (! first { $_ eq $sf } @{ $r->{$f} }) {
144                                                            push @errors, "$f has unknown subfield: $sf";
145                                                    }
146                                            }
147                                    }
148                            } elsif (ref($v) eq 'HASH') {
149                                    push @errors, "$f has subfields which is not valid";
150                            }
151                    }
152            }
153    
154            #$log->logcluck("return from this function is ARRAY") unless wantarray;
155    
156            $log->debug("errors: ", join(", ", @errors)) if (@errors);
157    
158            return @errors;
159    }
160    
161  =head1 AUTHOR  =head1 AUTHOR
162    
163  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.514  
changed lines
  Added in v.515
  ViewVC Help
Powered by ViewVC 1.1.26