/[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 826 by dpavlin, Fri Nov 3 19:41:28 2006 UTC revision 827 by dpavlin, Sun May 20 16:19:16 2007 UTC
# Line 18  WebPAC::Validate - provide simple valida Line 18  WebPAC::Validate - provide simple valida
18    
19  =head1 VERSION  =head1 VERSION
20    
21  Version 0.10  Version 0.11
22    
23  =cut  =cut
24    
25  our $VERSION = '0.10';  our $VERSION = '0.11';
26    
27  =head1 SYNOPSIS  =head1 SYNOPSIS
28    
# Line 52  Create new validation object Line 52  Create new validation object
52    
53    my $validate = new WebPAC::Validate(    my $validate = new WebPAC::Validate(
54          path => 'conf/validate/file',          path => 'conf/validate/file',
55            delimiters => [ ' : ', ' / ', ' ; ', ' , ' ],
56    );    );
57    
58    Optional parametar C<delimiters> will turn on validating of delimiters. Be
59    careful here, those delimiters are just stuck into regex, so they can
60    contain L<perlre> regexpes.
61    
62  =cut  =cut
63    
64  sub new {  sub new {
# Line 114  sub new { Line 119  sub new {
119    
120          $log->info("validation uses rules from $self->{path}");          $log->info("validation uses rules from $self->{path}");
121    
122            if ( $self->{delimiters} ) {
123                    $self->{delimiters_regex} = '(\^[a-z0-9]|' . join('|', @{ $self->{delimiters} }) . ')';
124                    $log->info("validation check delimiters with regex $self->{delimiters_regex}");
125            }
126    
127          $self ? return $self : return undef;          $self ? return $self : return undef;
128  }  }
129    
# Line 146  sub validate_rec { Line 156  sub validate_rec {
156    
157                  next if (!defined($f) || $f eq '' || $f eq '000');                  next if (!defined($f) || $f eq '' || $f eq '000');
158    
159                    # first check delimiters
160                    if ( my $regex = $self->{delimiters_regex} ) {
161    
162                            my $template = '';
163    
164                            foreach my $v (@{ $rec->{$f} }) {
165                                            warn "## v = ", dump( $v );
166                                            my $l = _pack_subfields_hash( $v, 1 );
167                                            warn "## $l [$regex]\n";
168                                            $l =~ s/$regex/$template.=$1/eg && warn "## new: $l\n";
169                                            warn "## template: $template\n";
170                                            $self->{_delimiters_templates}->{$f}->{$template}++;
171                            }
172    
173                    }
174    
175                  next if (defined( $self->{dont_validate}->{$f} ));                  next if (defined( $self->{dont_validate}->{$f} ));
176    
177                  # track field usage                  # track field usage
# Line 222  sub validate_rec { Line 248  sub validate_rec {
248                  }                  }
249          }          }
250    
251            $log->debug("_delimiters_templates = ", dump( $self->{_delimiters_templates} ) );
252    
253          foreach my $must (sort keys %{ $self->{must_exist} }) {          foreach my $must (sort keys %{ $self->{must_exist} }) {
254                  next if ($fields->{$must});                  next if ($fields->{$must});
255                  $errors->{$must}->{missing}++;                  $errors->{$must}->{missing}++;
Legend:
Removed from v.826  
changed lines
  Added in v.827
  ViewVC Help
Powered by ViewVC 1.1.26