/[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 1049 by dpavlin, Mon Nov 19 16:50:10 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 102  sub new { Line 135  sub new {
135                  if (@d) {                  if (@d) {
136                          $v->{$fld} = [ map {                          $v->{$fld} = [ map {
137                                  my $sf = $_;                                  my $sf = $_;
138                                  if ( $sf =~ s/!(\*)?$/$1/ ) {                                  if ( $sf =~ s/!// ) {
139                                          $self->{must_exist_sf}->{ $fld }->{ $sf }++;                                          $self->{must_exist_sf}->{ $fld }->{ $sf }++;
140                                  };                                  };
141                                  $sf;                                  $sf;
# 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 206  sub validate_rec { Line 273  sub validate_rec {
273  #                                       $errors->{dump} = $rec_dump if ($rec_dump);  #                                       $errors->{dump} = $rec_dump if ($rec_dump);
274                                  } elsif (ref($v) ne 'HASH') {                                  } elsif (ref($v) ne 'HASH') {
275                                          $errors->{$f}->{missing_subfield} = join(",", @{ $r->{$f} }) . " required";                                          $errors->{$f}->{missing_subfield} = join(",", @{ $r->{$f} }) . " required";
276                                            $errors->{$f}->{dump} = $v;
277                                          next;                                          next;
278                                  } else {                                  } else {
279    
# Line 257  sub validate_rec { Line 325  sub validate_rec {
325                  }                  }
326          }          }
327    
328          $log->debug("_delimiters_templates = ", dump( $self->{_delimiters_templates} ) );          $log->debug("_delimiters_templates = ", sub { dump( $self->{_delimiters_templates} ) } );
329    
330          foreach my $must (sort keys %{ $self->{must_exist} }) {          foreach my $must (sort keys %{ $self->{must_exist} }) {
331                  next if ($fields->{$must});                  next if ($fields->{$must});
# Line 268  sub validate_rec { Line 336  sub validate_rec {
336          if ($errors) {          if ($errors) {
337                  $log->debug("errors: ", $self->report_error( $errors ) );                  $log->debug("errors: ", $self->report_error( $errors ) );
338    
339                  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");
340                  $self->{errors}->{$mfn} = $errors;                  $self->{errors}->{$mfn} = $errors;
341          }          }
342    
# Line 277  sub validate_rec { Line 345  sub validate_rec {
345          return $errors;          return $errors;
346  }  }
347    
348  =head2 reset_errors  =head2 reset
349    
350    Clean all accumulated errors for this input and remember delimiter templates
351    for L<save_delimiters_templates>
352    
353  Clean all accumulated errors for this input    $validate->reset;
354    
355    $validate->reset_errors;  This function B<must> be called after each input to provide accurate statistics.
356    
357  =cut  =cut
358    
359  sub reset_errors {  sub reset {
360          my $self = shift;          my $self = shift;
361    
362            my $log = $self->_get_logger;
363    
364          delete ($self->{errors});          delete ($self->{errors});
365    
366            if ( ! $self->{_delimiters_templates} ) {
367                    $log->debug("called without _delimiters_templates?");
368                    return;
369            }
370    
371            foreach my $f ( keys %{ $self->{_delimiters_templates} } ) {
372                    foreach my $t ( keys %{ $self->{_delimiters_templates}->{$f} } ) {
373                            $self->{_accumulated_delimiters_templates}->{$f}->{$t} +=
374                                    $self->{_delimiters_templates}->{$f}->{$t};
375                    }
376            }
377            $log->debug("_accumulated_delimiters_templates = ", sub { dump( $self->{_accumulated_delimiters_templates} ) } );
378            delete ($self->{_delimiters_templates});
379  }  }
380    
381  =head2 all_errors  =head2 all_errors
# Line 348  sub report_error { Line 436  sub report_error {
436                                  $accumulated ? "$accumulated\t$k" : $k                                  $accumulated ? "$accumulated\t$k" : $k
437                          );                          );
438    
439                          $log->debug(                          $log->debug( "new_results: ", sub { dump($new_results) } ) if ( $new_results );
                                 ( $new_results          ? "new_results: " . dump($new_results) ." "     : '' ),  
                         );  
440    
441                          push @$results, $new_results if ($new_results);                          push @$results, $new_results if ($new_results);
442                          $dump = $new_dump if ($new_dump);                          $dump = $new_dump if ($new_dump);
443    
444                  }                  }
445    
446                  $log->debug(                  $log->debug( "results: ", sub { dump($results) } ) if ( $results );
                         ( $results              ? "results: " . dump($results) ." "     : '' ),  
                 );  
447    
448                  if ($#$results == 0) {                  if ($#$results == 0) {
449                          return ($results->[0], $dump);                          return ($results->[0], $dump);
# Line 423  Generate report of delimiter tamplates Line 507  Generate report of delimiter tamplates
507    
508    my $report = $validate->delimiter_teplates(    my $report = $validate->delimiter_teplates(
509          report => 1,          report => 1,
510            current_input => 1,
511    );    );
512    
513  Options:  Options:
# Line 433  Options: Line 518  Options:
518    
519  Generate humanly readable report with single fields  Generate humanly readable report with single fields
520    
521    =item current_input
522    
523    Report just current_input and not accumulated data
524    
525  =back  =back
526    
527  =cut  =cut
# Line 442  sub delimiters_templates { Line 531  sub delimiters_templates {
531    
532          my $args = {@_};          my $args = {@_};
533    
534          my $t = $self->{_delimiters_templates};          my $t = $self->{_accumulated_delimiters_templates};
535            $t = $self->{_delimiters_templates} if ( $args->{current_input} );
536    
537          my $log = $self->_get_logger;          my $log = $self->_get_logger;
538    
# Line 467  sub delimiters_templates { Line 557  sub delimiters_templates {
557          return $out;          return $out;
558  }  }
559    
560    =head2 save_delimiters_templates
561    
562    Save accumulated delimiter templates
563    
564      $validator->save_delimiters_template( '/path/to/validate/delimiters' );
565    
566    =cut
567    
568    sub save_delimiters_templates {
569            my $self = shift;
570    
571            my $path = shift;
572            $path ||= $self->{delimiters_path};
573    
574            my $log = $self->_get_logger;
575    
576            $log->logdie("need path") unless ( $path );
577    
578    
579            if ( ! $self->{_accumulated_delimiters_templates} ) {
580                    $log->error('no _accumulated_delimiters_templates found, reset');
581                    $self->reset;
582            }
583    
584            if ( $self->{_delimiters_templates} ) {
585                    $log->error('found _delimiters_templates, calling reset');
586                    $self->reset;
587            }
588    
589            $path .= '.new' if ( -e $path );
590    
591            open(my $d, '>', $path) || $log->fatal("can't open $path: $!");
592            print $d $self->delimiters_templates;
593            close($d);
594    
595            $log->info("new delimiters templates saved to $path");
596    
597            return 1;
598    }
599    
600  =head1 AUTHOR  =head1 AUTHOR
601    
602  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.836  
changed lines
  Added in v.1049
  ViewVC Help
Powered by ViewVC 1.1.26