r669@llin: dpavlin | 2006-05-15 15:18:36 +0200

 added nicely formatted stats and --stats flag to run.pl

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@507 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/TODO b/TODO
index 7ea3ecd..439afc8 100644 (file)
--- a/TODO
+++ b/TODO
@@ -13,6 +13,7 @@
 + apply regex on records from input to fix-up character encodings [2.11]
 + add support for KinoSearch search library [2.12]
 + added new set-based normalizer which is pure perl code [2.13]
++ added --stats to report field and subfield usage [2.14]
 - support arrays for normalize/path and lookup
 - add Excel input format
 - add dBase input format

diff --git a/lib/WebPAC.pm b/lib/WebPAC.pm
index 42c58b0..c6d4d28 100644 (file)
--- a/lib/WebPAC.pm
+++ b/lib/WebPAC.pm
@@ -9,11 +9,11 @@ WebPAC - core module
 
 =head1 VERSION
 
-Version 2.13
+Version 2.14
 
 =cut
 
-our $VERSION = '2.13';
+our $VERSION = '2.14';
 
 =head1 SYNOPSIS
 

diff --git a/lib/WebPAC/Input.pm b/lib/WebPAC/Input.pm
index 8f4c3d4..bc4350e 100644 (file)
--- a/lib/WebPAC/Input.pm
+++ b/lib/WebPAC/Input.pm
@@ -3,6 +3,8 @@ package WebPAC::Input;
 use warnings;
 use strict;
 
+use blib;
+
 use WebPAC::Common;
 use base qw/WebPAC::Common/;
 use Text::Iconv;
@@ -426,13 +428,48 @@ sub seek {
 
 Dump statistics about field and subfield usage
 
-  print Dumper( $input->stats );
+  print $input->stats;
 
 =cut
 
 sub stats {
        my $self = shift;
-       return $self->{_stats};
+
+       my $log = $self->_get_logger();
+
+       my $s = $self->{_stats};
+       if (! $s) {
+               $log->warn("called stats, but there is no statistics collected");
+               return;
+       }
+
+       my $max_fld = 0;
+
+       my $out = join("\n",
+               map {
+                       my $f = $_ || die "no field";
+                       my $v = $s->{fld}->{$f} || die "no s->{fld}->{$f}";
+                       $max_fld = $v if ($v > $max_fld);
+
+                       my $o = sprintf("%4d %d ~", $f, $v);
+
+                       if (defined($s->{sf}->{$f})) {
+                               map {
+                                       $o .= sprintf(" %s:%d", $_, $s->{sf}->{$f}->{$_});
+                               } sort keys %{ $s->{sf}->{$f} };
+                       }
+
+                       if (my $v_r = $s->{repeatable}->{$f}) {
+                               $o .= " ($v_r)" if ($v_r != $v);
+                       }
+
+                       $o;
+               } sort { $a <=> $b } keys %{ $s->{fld} }
+       );
+
+       $log->debug( sub { Dumper($s) } );
+
+       return $out;
 }
 
 =head1 MEMORY USAGE

diff --git a/run.pl b/run.pl
index 0148736..c8bd312 100755 (executable)
--- a/run.pl
+++ b/run.pl
@@ -55,6 +55,10 @@ path to YAML configuration file
 force conversion C<normalize->path> in C<config.yml> from
 C<.xml> to C<.pl>
 
+=item --stats
+
+dump statistics about used fields and subfields in each input
+
 =back
 
 =cut
@@ -67,6 +71,7 @@ my $config = 'conf/config.yml';
 my $debug = 0;
 my $only_db_name;
 my $force_set = 0;
+my $stats = 0;
 
 GetOptions(
        "limit=i" => \$limit,
@@ -77,6 +82,7 @@ GetOptions(
        "config" => \$config,
        "debug" => \$debug,
        "force-set" => \$force_set,
+       "stats" => \$stats,
 );
 
 $config = LoadFile($config);
@@ -181,6 +187,7 @@ while (my ($database, $db_config) = each %{ $config->{databases} }) {
                        offset => $offset,
                        lookup => $lookup,
                        recode => $input->{recode},
+                       stats => $stats,
                );
                $log->logdie("can't create input using $input_module") unless ($input);
 
@@ -255,6 +262,8 @@ while (my ($database, $db_config) = each %{ $config->{databases} }) {
                        $total_rows++;
                }
 
+               $log->info("statistics of fields usage:\n", $input_db->stats) if ($stats);
+
        };
 
        eval { $indexer->finish } if ($indexer->can('finish'));

diff --git a/t/2-input.t b/t/2-input.t
index 8d32e17..faf4a8e 100755 (executable)
--- a/t/2-input.t
+++ b/t/2-input.t
@@ -79,7 +79,7 @@ test_start_limit($input, 3, $size, $size - 2);
 test_start_limit($input, 1, $size + 2, $size);
 
 ok(my $s = $input->stats, 'stats');
-diag "stats: ",Dumper($s);
+diag "stats:\n$s";
 
 $module = 'WebPAC::Input::MARC';
 diag "testing with $module";