/[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 838 by dpavlin, Thu May 24 14:42:35 2007 UTC revision 852 by dpavlin, Sun May 27 11:27:12 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 67  sub new { Line 67  sub new {
67          my $self = {@_};          my $self = {@_};
68          bless($self, $class);          bless($self, $class);
69    
 warn dump( @_ );  
   
70          my $log = $self->_get_logger();          my $log = $self->_get_logger();
71    
72            $log->logdie("need path or delimiters_path") unless ( $self->{path} || $self->{delimiters_path} );
73    
74          if ( $self->{path} ) {          if ( $self->{path} ) {
75    
76                  my $v_file = read_file( $self->{path} ) ||                  my $v_file = read_file( $self->{path} ) ||
# Line 140  warn dump( @_ ); Line 140  warn dump( @_ );
140                                  }                                  }
141                          }                          }
142                          close($d);                          close($d);
143                          warn "_validate_delimiters_templates = ",dump( $self->{_validate_delimiters_templates} );                          #warn "_validate_delimiters_templates = ",dump( $self->{_validate_delimiters_templates} );
144                  } else {                  } else {
145                          $log->warn("delimiters path $path doesn't exist, it will be created after this run");                          $log->warn("delimiters path $path doesn't exist, it will be created after this run");
146                  }                  }
# Line 194  sub validate_rec { Line 194  sub validate_rec {
194    
195                                          if ( my $v = $self->{_validate_delimiters_templates} ) {                                          if ( my $v = $self->{_validate_delimiters_templates} ) {
196                                                  if ( ! defined( $v->{$f}->{$template} ) ) {                                                  if ( ! defined( $v->{$f}->{$template} ) ) {
197                                                          $errors->{$f}->{invalid_delimiters_combination} = $template;                                                          $errors->{$f}->{potentially_invalid_combination} = $template;
198                                                          $errors->{$f}->{dump} = $subfield_dump;                                                          $errors->{$f}->{dump} = $subfield_dump;
199                                                  #} else {                                                  #} else {
200                                                  #       warn "## $f $template ok\n";                                                  #       warn "## $f $template ok\n";
# Line 282  sub validate_rec { Line 282  sub validate_rec {
282                  }                  }
283          }          }
284    
285          $log->debug("_delimiters_templates = ", dump( $self->{_delimiters_templates} ) );          $log->debug("_delimiters_templates = ", sub { dump( $self->{_delimiters_templates} ) } );
286    
287          foreach my $must (sort keys %{ $self->{must_exist} }) {          foreach my $must (sort keys %{ $self->{must_exist} }) {
288                  next if ($fields->{$must});                  next if ($fields->{$must});
# Line 293  sub validate_rec { Line 293  sub validate_rec {
293          if ($errors) {          if ($errors) {
294                  $log->debug("errors: ", $self->report_error( $errors ) );                  $log->debug("errors: ", $self->report_error( $errors ) );
295    
296                  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");
297                  $self->{errors}->{$mfn} = $errors;                  $self->{errors}->{$mfn} = $errors;
298          }          }
299    
# Line 302  sub validate_rec { Line 302  sub validate_rec {
302          return $errors;          return $errors;
303  }  }
304    
305  =head2 reset_errors  =head2 reset
306    
307    Clean all accumulated errors for this input and remember delimiter templates
308    for L<save_delimiters_templates>
309    
310  Clean all accumulated errors for this input    $validate->reset;
311    
312    $validate->reset_errors;  This function B<must> be called after each input to provide accurate statistics.
313    
314  =cut  =cut
315    
316  sub reset_errors {  sub reset {
317          my $self = shift;          my $self = shift;
318    
319            my $log = $self->_get_logger;
320    
321          delete ($self->{errors});          delete ($self->{errors});
322    
323            if ( ! $self->{_delimiters_templates} ) {
324                    $log->debug("called without _delimiters_templates?");
325                    return;
326            }
327    
328            foreach my $f ( keys %{ $self->{_delimiters_templates} } ) {
329                    foreach my $t ( keys %{ $self->{_delimiters_templates}->{$f} } ) {
330                            $self->{_accumulated_delimiters_templates}->{$f}->{$t} +=
331                                    $self->{_delimiters_templates}->{$f}->{$t};
332                    }
333            }
334            $log->debug("_accumulated_delimiters_templates = ", sub { dump( $self->{_accumulated_delimiter_templates} ) } );
335            delete ($self->{_delimiters_templates});
336  }  }
337    
338  =head2 all_errors  =head2 all_errors
# Line 373  sub report_error { Line 393  sub report_error {
393                                  $accumulated ? "$accumulated\t$k" : $k                                  $accumulated ? "$accumulated\t$k" : $k
394                          );                          );
395    
396                          $log->debug(                          $log->debug( "new_results: ", sub { dump($new_results) } ) if ( $new_results );
                                 ( $new_results          ? "new_results: " . dump($new_results) ." "     : '' ),  
                         );  
397    
398                          push @$results, $new_results if ($new_results);                          push @$results, $new_results if ($new_results);
399                          $dump = $new_dump if ($new_dump);                          $dump = $new_dump if ($new_dump);
400    
401                  }                  }
402    
403                  $log->debug(                  $log->debug( "results: ", sub { dump($results) } ) if ( $results );
                         ( $results              ? "results: " . dump($results) ." "     : '' ),  
                 );  
404    
405                  if ($#$results == 0) {                  if ($#$results == 0) {
406                          return ($results->[0], $dump);                          return ($results->[0], $dump);
# Line 448  Generate report of delimiter tamplates Line 464  Generate report of delimiter tamplates
464    
465    my $report = $validate->delimiter_teplates(    my $report = $validate->delimiter_teplates(
466          report => 1,          report => 1,
467            current_input => 1,
468    );    );
469    
470  Options:  Options:
# Line 458  Options: Line 475  Options:
475    
476  Generate humanly readable report with single fields  Generate humanly readable report with single fields
477    
478    =item current_input
479    
480    Report just current_input and not accumulated data
481    
482  =back  =back
483    
484  =cut  =cut
# Line 467  sub delimiters_templates { Line 488  sub delimiters_templates {
488    
489          my $args = {@_};          my $args = {@_};
490    
491          my $t = $self->{_delimiters_templates};          my $t = $self->{_accumulated_delimiters_templates};
492            $t = $self->{_delimiters_templates} if ( $args->{current_input} );
493    
494          my $log = $self->_get_logger;          my $log = $self->_get_logger;
495    
# Line 494  sub delimiters_templates { Line 516  sub delimiters_templates {
516    
517  =head2 save_delimiters_templates  =head2 save_delimiters_templates
518    
519    Save accumulated delimiter templates
520    
521      $validator->save_delimiters_template( '/path/to/validate/delimiters' );
522    
523  =cut  =cut
524    
525  sub save_delimiters_templates {  sub save_delimiters_templates {
# Line 505  sub save_delimiters_templates { Line 531  sub save_delimiters_templates {
531    
532          my $log = $self->_get_logger;          my $log = $self->_get_logger;
533    
534            if ( ! $self->{_accumulated_delimiters_templates} ) {
535                    $log->error('no _accumulated_delimiters_templates found, reset');
536                    $self->reset;
537            }
538    
539            if ( ! $self->{_delimiters_templates} ) {
540                    $log->error('found _delimiters_templates, calling reset');
541                    $self->reset;
542            }
543    
544            $path .= '.new' if ( -e $path );
545    
546          open(my $d, '>', $path) || $log->fatal("can't open $path: $!");          open(my $d, '>', $path) || $log->fatal("can't open $path: $!");
547          print $d $self->delimiters_templates;          print $d $self->delimiters_templates;
548          close($d);          close($d);
Legend:
Removed from v.838  
changed lines
  Added in v.852
  ViewVC Help
Powered by ViewVC 1.1.26