/[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 836 by dpavlin, Thu May 24 12:44:43 2007 UTC revision 864 by dpavlin, Sun May 27 22:24:30 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.11  Version 0.12
22    
23  =cut  =cut
24    
25  our $VERSION = '0.11';  our $VERSION = '0.12';
26    
27  =head1 SYNOPSIS  =head1 SYNOPSIS
28    
# Line 53  Create new validation object Line 53  Create new validation object
53    my $validate = new WebPAC::Validate(    my $validate = new WebPAC::Validate(
54          path => 'conf/validate/file',          path => 'conf/validate/file',
55          delimiters => [ ' : ', ' / ', ' ; ', ' , ' ],          delimiters => [ ' : ', ' / ', ' ; ', ' , ' ],
56            delimiters_path => 'conf/validate/delimiters/file',
57    );    );
58    
59  Optional parametar C<delimiters> will turn on validating of delimiters. Be  Optional parametar C<delimiters> will turn on validating of delimiters. Be
60  careful here, those delimiters are just stuck into regex, so they can  careful here, those delimiters are just stuck into regex, so they can
61  contain L<perlre> regexpes.  contain L<perlre> regexpes.
62    
63    C<path> and C<delimiters_path> can be specified by L<read_validate_file> and
64    L<read_validate_delimiters> calls.
65    
66  =cut  =cut
67    
68  sub new {  sub new {
# Line 68  sub new { Line 72  sub new {
72    
73          my $log = $self->_get_logger();          my $log = $self->_get_logger();
74    
75          foreach my $p (qw/path/) {          $self->read_validate_file( $self->{path} ) if ( $self->{path} );
76                  $log->logconfess("need $p") unless ($self->{$p});  
77            if ( $self->{delimiters} ) {
78                    $self->{delimiters_regex} = '(\^[a-z0-9]|' . join('|', @{ $self->{delimiters} }) . ')';
79                    $log->info("validation check delimiters with regex $self->{delimiters_regex}");
80          }          }
81    
82          my $v_file = read_file( $self->{path} ) ||          $self->read_validate_delimiters_file( $self->{delimiters_path} ) if ( $self->{delimiters_path} );
83                  $log->logdie("can't open validate path $self->{path}: $!");  
84            return $self;
85    }
86    
87    
88    =head2 read_validate_file
89    
90    Specify validate rules file
91    
92      $validate->read_validate_file( 'conf/validate/file' );
93    
94    Returns number of lines in file
95    
96    =cut
97    
98    sub read_validate_file {
99            my $self = shift;
100    
101            my $path = shift || die "no path?";
102    
103            my $log = $self->_get_logger();
104    
105            my $v_file = read_file( $path ) ||
106                    $log->logdie("can't open validate path $path: $!");
107    
108          my $v;          my $v;
109            delete( $self->{must_exist} );
110            delete( $self->{must_exist_sf} );
111            delete( $self->{dont_validate} );
112          my $curr_line = 1;          my $curr_line = 1;
113    
114          foreach my $l (split(/[\n\r]+/, $v_file)) {          foreach my $l (split(/[\n\r]+/, $v_file)) {
# Line 117  sub new { Line 150  sub new {
150    
151          $self->{rules} = $v;          $self->{rules} = $v;
152    
153          $log->info("validation uses rules from $self->{path}");          $log->info("validation uses rules from $path");
154    
155          if ( $self->{delimiters} ) {          return $curr_line;
156                  $self->{delimiters_regex} = '(\^[a-z0-9]|' . join('|', @{ $self->{delimiters} }) . ')';  }
157                  $log->info("validation check delimiters with regex $self->{delimiters_regex}");  
158          }  =head2 read_validate_delimiters_file
159    
160      $validate->read_validate_delimiters_file( 'conf/validate/delimiters/file' );
161    
162    =cut
163    
164    sub read_validate_delimiters_file {
165            my $self = shift;
166    
167          $self ? return $self : return undef;          my $path = shift || die "no path?";
168    
169            my $log = $self->_get_logger();
170    
171            delete( $self->{_validate_delimiters_templates} );
172            delete( $self->{_delimiters_templates} );
173    
174            if ( -e $path ) {
175                    $log->info("using delimiter validation rules from $path");
176                    open(my $d, $path) || $log->fatal("can't open $path: $!");
177                    while(<$d>) {
178                            chomp($d);
179                            if (/^\s*(#*)\s*(\d+)\t+(\d+)\t+(.*)$/) {
180                                    my ($comment,$field,$count,$template) = ($1,$2,$3,$4);
181                                    $self->{_validate_delimiters_templates}->{$field}->{$template} = $count unless ($comment);
182                            } else {
183                                    warn "## ignored $d\n";
184                            }
185                    }
186                    close($d);
187                    #warn "_validate_delimiters_templates = ",dump( $self->{_validate_delimiters_templates} );
188            } else {
189                    $log->warn("delimiters path $path doesn't exist, it will be created after this run");
190            }
191            $self->{delimiters_path} = $path;
192  }  }
193    
194  =head2 validate_rec  =head2 validate_rec
# Line 144  sub validate_rec { Line 208  sub validate_rec {
208          my $rec_dump = shift;          my $rec_dump = shift;
209    
210          $log->logdie("rec isn't HASH") unless (ref($rec) eq 'HASH');          $log->logdie("rec isn't HASH") unless (ref($rec) eq 'HASH');
211          $log->logdie("can't find validation rules") unless (my $r = $self->{rules});  #       $log->logdie("can't find validation rules") unless (my $r = $self->{rules});
212            my $r = $self->{rules};
213    
214          my $errors;          my $errors;
215    
# Line 170  sub validate_rec { Line 235  sub validate_rec {
235                                          $self->{_delimiters_templates}->{$f}->{$template}++;                                          $self->{_delimiters_templates}->{$f}->{$template}++;
236    
237                                          if ( my $v = $self->{_validate_delimiters_templates} ) {                                          if ( my $v = $self->{_validate_delimiters_templates} ) {
238                                                  if ( ! defined( $v->{$template} ) ) {                                                  if ( ! defined( $v->{$f}->{$template} ) ) {
239                                                          $errors->{$f}->{invalid_delimiters_combination} = $template;                                                          $errors->{$f}->{potentially_invalid_combination} = $template;
240                                                          $errors->{$f}->{dump} = $subfield_dump;                                                          $errors->{$f}->{dump} = $subfield_dump;
241                                                  } else {                                                  #} else {
242                                                          warn "## $f $template ok\n";                                                  #       warn "## $f $template ok\n";
243                                                  }                                                  }
244                                          }                                          }
245                                  }                                  }
246                          }                          }
247                  }                  }
248    
249                    next unless ( $r );     # skip validation of no rules are specified
250    
251                  next if (defined( $self->{dont_validate}->{$f} ));                  next if (defined( $self->{dont_validate}->{$f} ));
252    
253                  # track field usage                  # track field usage
# Line 257  sub validate_rec { Line 324  sub validate_rec {
324                  }                  }
325          }          }
326    
327          $log->debug("_delimiters_templates = ", dump( $self->{_delimiters_templates} ) );          $log->debug("_delimiters_templates = ", sub { dump( $self->{_delimiters_templates} ) } );
328    
329          foreach my $must (sort keys %{ $self->{must_exist} }) {          foreach my $must (sort keys %{ $self->{must_exist} }) {
330                  next if ($fields->{$must});                  next if ($fields->{$must});
# Line 268  sub validate_rec { Line 335  sub validate_rec {
335          if ($errors) {          if ($errors) {
336                  $log->debug("errors: ", $self->report_error( $errors ) );                  $log->debug("errors: ", $self->report_error( $errors ) );
337    
338                  my $mfn = $rec->{'000'}->[0] || $log->logconfess("record ", dump( $rec ), " doesn't have MFN");                  my $mfn = $rec->{'000'}->[0] || $log->logconfess("record ", sub { dump( $rec ) }, " doesn't have MFN");
339                  $self->{errors}->{$mfn} = $errors;                  $self->{errors}->{$mfn} = $errors;
340          }          }
341    
# Line 277  sub validate_rec { Line 344  sub validate_rec {
344          return $errors;          return $errors;
345  }  }
346    
347  =head2 reset_errors  =head2 reset
348    
349    Clean all accumulated errors for this input and remember delimiter templates
350    for L<save_delimiters_templates>
351    
352  Clean all accumulated errors for this input    $validate->reset;
353    
354    $validate->reset_errors;  This function B<must> be called after each input to provide accurate statistics.
355    
356  =cut  =cut
357    
358  sub reset_errors {  sub reset {
359          my $self = shift;          my $self = shift;
360    
361            my $log = $self->_get_logger;
362    
363          delete ($self->{errors});          delete ($self->{errors});
364    
365            if ( ! $self->{_delimiters_templates} ) {
366                    $log->debug("called without _delimiters_templates?");
367                    return;
368            }
369    
370            foreach my $f ( keys %{ $self->{_delimiters_templates} } ) {
371                    foreach my $t ( keys %{ $self->{_delimiters_templates}->{$f} } ) {
372                            $self->{_accumulated_delimiters_templates}->{$f}->{$t} +=
373                                    $self->{_delimiters_templates}->{$f}->{$t};
374                    }
375            }
376            $log->debug("_accumulated_delimiters_templates = ", sub { dump( $self->{_accumulated_delimiters_templates} ) } );
377            delete ($self->{_delimiters_templates});
378  }  }
379    
380  =head2 all_errors  =head2 all_errors
# Line 348  sub report_error { Line 435  sub report_error {
435                                  $accumulated ? "$accumulated\t$k" : $k                                  $accumulated ? "$accumulated\t$k" : $k
436                          );                          );
437    
438                          $log->debug(                          $log->debug( "new_results: ", sub { dump($new_results) } ) if ( $new_results );
                                 ( $new_results          ? "new_results: " . dump($new_results) ." "     : '' ),  
                         );  
439    
440                          push @$results, $new_results if ($new_results);                          push @$results, $new_results if ($new_results);
441                          $dump = $new_dump if ($new_dump);                          $dump = $new_dump if ($new_dump);
442    
443                  }                  }
444    
445                  $log->debug(                  $log->debug( "results: ", sub { dump($results) } ) if ( $results );
                         ( $results              ? "results: " . dump($results) ." "     : '' ),  
                 );  
446    
447                  if ($#$results == 0) {                  if ($#$results == 0) {
448                          return ($results->[0], $dump);                          return ($results->[0], $dump);
# Line 423  Generate report of delimiter tamplates Line 506  Generate report of delimiter tamplates
506    
507    my $report = $validate->delimiter_teplates(    my $report = $validate->delimiter_teplates(
508          report => 1,          report => 1,
509            current_input => 1,
510    );    );
511    
512  Options:  Options:
# Line 433  Options: Line 517  Options:
517    
518  Generate humanly readable report with single fields  Generate humanly readable report with single fields
519    
520    =item current_input
521    
522    Report just current_input and not accumulated data
523    
524  =back  =back
525    
526  =cut  =cut
# Line 442  sub delimiters_templates { Line 530  sub delimiters_templates {
530    
531          my $args = {@_};          my $args = {@_};
532    
533          my $t = $self->{_delimiters_templates};          my $t = $self->{_accumulated_delimiters_templates};
534            $t = $self->{_delimiters_templates} if ( $args->{current_input} );
535    
536          my $log = $self->_get_logger;          my $log = $self->_get_logger;
537    
# Line 467  sub delimiters_templates { Line 556  sub delimiters_templates {
556          return $out;          return $out;
557  }  }
558    
559    =head2 save_delimiters_templates
560    
561    Save accumulated delimiter templates
562    
563      $validator->save_delimiters_template( '/path/to/validate/delimiters' );
564    
565    =cut
566    
567    sub save_delimiters_templates {
568            my $self = shift;
569    
570            my $path = shift;
571            $path ||= $self->{delimiters_path};
572    
573            my $log = $self->_get_logger;
574    
575            $log->logdie("need path") unless ( $path );
576    
577    
578            if ( ! $self->{_accumulated_delimiters_templates} ) {
579                    $log->error('no _accumulated_delimiters_templates found, reset');
580                    $self->reset;
581            }
582    
583            if ( $self->{_delimiters_templates} ) {
584                    $log->error('found _delimiters_templates, calling reset');
585                    $self->reset;
586            }
587    
588            $path .= '.new' if ( -e $path );
589    
590            open(my $d, '>', $path) || $log->fatal("can't open $path: $!");
591            print $d $self->delimiters_templates;
592            close($d);
593    
594            $log->info("new delimiters templates saved to $path");
595    }
596    
597  =head1 AUTHOR  =head1 AUTHOR
598    
599  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.836  
changed lines
  Added in v.864
  ViewVC Help
Powered by ViewVC 1.1.26