r1221@llin: dpavlin | 2007-05-20 22:43:38 +0200

[webpac2] / lib / WebPAC / Validate.pm

diff --git a/lib/WebPAC/Validate.pm b/lib/WebPAC/Validate.pm
index dafe201..f356046 100644 (file)
--- a/lib/WebPAC/Validate.pm
+++ b/lib/WebPAC/Validate.pm
@@ -159,15 +159,12 @@ sub validate_rec {
                # first check delimiters
                if ( my $regex = $self->{delimiters_regex} ) {
 
-                       my $template = '';
-
                        foreach my $v (@{ $rec->{$f} }) {
-                                       warn "## v = ", dump( $v );
                                        my $l = _pack_subfields_hash( $v, 1 );
-                                       warn "## $l [$regex]\n";
-                                       $l =~ s/$regex/$template.=$1/eg && warn "## new: $l\n";
-                                       warn "## template: $template\n";
-                                       $self->{_delimiters_templates}->{$f}->{$template}++;
+                                       my $template = '';
+                                       $l =~ s/$regex/$template.=$1/eg;
+#                                      warn "## template: $template\n";
+                                       $self->{_delimiters_templates}->{$f}->{$template}++ if ( $template );
                        }
 
                }
@@ -408,6 +405,35 @@ sub report {
 
 }
 
+=head2 delimiters_templates
+
+
+=cut
+
+sub delimiters_templates {
+       my $self = shift;
+
+       my $t = $self->{_delimiters_templates};
+
+       my $log = $self->_get_logger;
+
+       unless ($t) {
+               $log->warn("called without delimiters");
+               return;
+       }
+
+       my $out;
+
+       foreach my $f (sort { $a <=> $b } keys %$t) {
+               $out .= "$f\n";
+               foreach my $sft (sort { $a cmp $b } keys %{ $t->{$f} }) {
+                       $out .= "\t" . $t->{$f}->{$sft} . "\t$sft\n";
+               }
+       }
+
+       return $out;
+}
+
 =head1 AUTHOR
 
 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>