/[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 827 by dpavlin, Sun May 20 16:19:16 2007 UTC revision 834 by dpavlin, Thu May 24 10:53:48 2007 UTC
# Line 159  sub validate_rec { Line 159  sub validate_rec {
159                  # first check delimiters                  # first check delimiters
160                  if ( my $regex = $self->{delimiters_regex} ) {                  if ( my $regex = $self->{delimiters_regex} ) {
161    
                         my $template = '';  
   
162                          foreach my $v (@{ $rec->{$f} }) {                          foreach my $v (@{ $rec->{$f} }) {
                                         warn "## v = ", dump( $v );  
163                                          my $l = _pack_subfields_hash( $v, 1 );                                          my $l = _pack_subfields_hash( $v, 1 );
164                                          warn "## $l [$regex]\n";                                          my $template = '';
165                                          $l =~ s/$regex/$template.=$1/eg && warn "## new: $l\n";                                          $l =~ s/$regex/$template.=$1/eg;
166                                          warn "## template: $template\n";  #                                       warn "## template: $template\n";
167                                          $self->{_delimiters_templates}->{$f}->{$template}++;                                          $self->{_delimiters_templates}->{$f}->{$template}++ if ( $template );
168                          }                          }
169    
170                  }                  }
# Line 408  sub report { Line 405  sub report {
405    
406  }  }
407    
408    =head2 delimiters_templates
409    
410    Generate report of delimiter tamplates
411    
412      my $report = $validate->delimiter_teplates(
413            report => 1,
414      );
415    
416    Options:
417    
418    =over 4
419    
420    =item report
421    
422    Generate humanly readable report with single fields
423    
424    =back
425    
426    =cut
427    
428    sub delimiters_templates {
429            my $self = shift;
430    
431            my $args = {@_};
432    
433            my $t = $self->{_delimiters_templates};
434    
435            my $log = $self->_get_logger;
436    
437            unless ($t) {
438                    $log->error("called without delimiters");
439                    return;
440            }
441    
442            my $out;
443    
444            foreach my $f (sort { $a <=> $b } keys %$t) {
445                    $out .= "$f\n" if ( $args->{report} );
446                    foreach my $template (sort { $a cmp $b } keys %{ $t->{$f} }) {
447                            my $count = $t->{$f}->{$template};
448                            $out .=
449                                    ( $count ? "" : "# " ) .
450                                    ( $args->{report} ? "" : "$f\t" ) .
451                                    "\t$count\t$template\n";
452                    }
453            }
454    
455            return $out;
456    }
457    
458  =head1 AUTHOR  =head1 AUTHOR
459    
460  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.827  
changed lines
  Added in v.834
  ViewVC Help
Powered by ViewVC 1.1.26