r11787@llin: dpavlin | 2005-12-19 06:10:47 +0100

 MARC indexing seems to work

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

diff --git a/lib/WebPAC/Input.pm b/lib/WebPAC/Input.pm
index c2b5fe6..26512b1 100644 (file)
--- a/lib/WebPAC/Input.pm
+++ b/lib/WebPAC/Input.pm
@@ -100,7 +100,9 @@ sub new {
        foreach my $subclass (qw/open_db fetch_rec init/) {
                my $n = $self->{module} . '::' . $subclass;
                if (! defined &{ $n }) {
-                       $log->logwarn("missing implementation of $subclass");
+                       my $missing = "missing $subclass in $self->{module}";
+                       $log->logwarn($missing);
+                       $self->{$subclass} = sub { warn "$missing\n" };
                } else {
                        $self->{$subclass} = \&{ $n };
                }

diff --git a/lib/WebPAC/Input/MARC.pm b/lib/WebPAC/Input/MARC.pm
index fdcce36..2786018 100644 (file)
--- a/lib/WebPAC/Input/MARC.pm
+++ b/lib/WebPAC/Input/MARC.pm
@@ -51,7 +51,9 @@ sub open_db {
        $log->info("opening MARC database '$arg->{path}'");
 
        my $db = new MARC::Fast( marcdb => $arg->{path});
-       my $db_size = $db->count;
+       my $db_size = $db->count - 1;   # FIXME
+
+       $self->{size} = $db_size;
 
        return ($db, $db_size);
 }
@@ -71,7 +73,13 @@ sub fetch_rec {
 
        my ($db, $mfn) = @_;
 
-       return $db->fetch($mfn);
+       if ($mfn > $self->{size}) {
+               $self->_get_logger()->warn("seek beyond database size $self->{size} to $mfn");
+       } else {
+               my $row = $db->fetch($mfn);
+               $row->{'000'}->[0] = $mfn;
+               return $row;
+       }
 }
 
 =head1 AUTHOR

diff --git a/run.pl b/run.pl
index 1a0045a..1bf4b80 100755 (executable)
--- a/run.pl
+++ b/run.pl
@@ -125,11 +125,17 @@ while (my ($database, $db_config) = each %{ $config->{databases} }) {
                        );
                }
 
-               for ( 0 ... $input_db->size ) {
+               foreach my $pos ( 0 ... $input_db->size ) {
 
                        my $row = $input_db->fetch || next;
 
-                       my $mfn = $row->{'000'}->[0] || die "can't find MFN";
+                       my $mfn = $row->{000}->[0] || $row->{000} || die "can't find MFN";
+
+                       if ($mfn =~ m#^\d+$#) {
+                               $log->warn("record $pos doesn't have valid MFN but '$mfn', using $pos");
+                               $mfn = $pos;
+                               $row->{000}->[0] = $pos;
+                       }
 
                        my $ds = $n->data_structure($row);
 

diff --git a/t/2-input.t b/t/2-input.t
index afc0b1a..de258ac 100755 (executable)
--- a/t/2-input.t
+++ b/t/2-input.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 49;
+use Test::More tests => 61;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
@@ -8,16 +8,18 @@ use strict;
 
 BEGIN {
 use_ok( 'WebPAC::Input::ISIS' );
+use_ok( 'WebPAC::Input::MARC' );
 }
 
 ok(my $abs_path = abs_path($0), "abs_path");
 $abs_path =~ s#/[^/]*$#/#;
 
 my $module = 'WebPAC::Input::ISIS';
+diag "testing with $module";
 
 throws_ok { my $input = new WebPAC::Input( ) } qr/module/, "need module";
 ok(my $input = new WebPAC::Input( module => $module, no_log => 0 ), "new");
-ok(my $input_lm = new WebPAC::Input( module => $module, low_mem => 1, no_log => 1 ), "new");
+ok(my $input_lm = new WebPAC::Input( module => $module, low_mem => 1, no_log => 1 ), "new $module");
 
 throws_ok { $input->open( ) } qr/path/, "need path";
 
@@ -26,31 +28,38 @@ throws_ok { $input->open( path => '/dev/null', ) } qr/can't find database/ , "op
 ok($input->open( path => "$abs_path/winisis/BIBL" ), "open");
 ok($input_lm->open( path => "$abs_path/winisis/BIBL", low_mem => 1 ), "open");
 
-cmp_ok($input->pos, '==', -1, "mfn");
+sub test_after_open($) {
+       my $input = shift;
 
-ok(my $size = $input->size, "size");
+       cmp_ok($input->pos, '==', -1, "mfn");
+       ok(my $size = $input->size, "size");
+       return $size;
+}
 
-my @db1;
+test_after_open($input);
+my $size = test_after_open($input_lm);
 
-foreach my $mfn ( 1 ... $size ) {
-       ok(my $rec = $input->fetch, "fetch");
-       cmp_ok($input->pos, '==', $mfn, "rec $mfn");
-       push @db1, $rec;
-}
+sub test_fetch($$) {
+       my ($input, $size) = @_;
+
+       my @db;
 
-my @db2;
+       foreach my $mfn ( 1 ... $size ) {
+               ok(my $rec = $input->fetch, "fetch $mfn");
+               cmp_ok($input->pos, '==', $mfn, "pos $mfn");
+               push @db, $rec;
+       }
 
-foreach my $mfn ( 1 ... $size ) {
-       ok($input_lm->seek($mfn), "seek");
-       ok(my $rec = $input_lm->fetch, "fetch");
-       cmp_ok($input_lm->pos, '==', $mfn, "rec $mfn");
-       push @db2, $rec;
+       return @db;
 }
 
+my @db1 = test_fetch($input, $size);
+my @db2 = test_fetch($input_lm, $size);
+
 is_deeply(\@db1, \@db2, "seek working");
 
-sub test_start_limit($$$) {
-       my ($s,$l,$e) = @_;
+sub test_start_limit($$$$) {
+       my ($input, $s,$l,$e) = @_;
 
        diag "offset $s, limit: $l, expected: $e";
 
@@ -59,8 +68,19 @@ sub test_start_limit($$$) {
        cmp_ok($input->size, '==', $e, "input->size = $e");
 }
 
-test_start_limit(1, 3, 3);
-test_start_limit($size, 3, 0);
-test_start_limit(3, $size, $size - 2);
-test_start_limit(1, $size + 2, $size);
+test_start_limit($input, 1, 3, 3);
+test_start_limit($input, $size, 3, 0);
+test_start_limit($input, 3, $size, $size - 2);
+test_start_limit($input, 1, $size + 2, $size);
+
+$module = 'WebPAC::Input::MARC';
+diag "testing with $module";
+
+ok($input = new WebPAC::Input( module => $module, low_mem => 1, no_log => 1 ), "new $module");
+
+ok($input->open( path => "$abs_path/data/marc.iso" ), "open");
+
+test_after_open($input);
+
+test_fetch($input, $input->size);