git.rot13.org Git - webpac2/blob - t/2-input.t

   1 #!/usr/bin/perl -w
   2
   3 use Test::More tests => 104;
   4 use Test::Exception;
   5 use Cwd qw/abs_path/;
   6 use blib;
   7 use strict;
   8
   9 use Data::Dump qw/dump/;
  10
  11 BEGIN {
  12 use_ok( 'WebPAC::Input::ISIS' );
  13 use_ok( 'WebPAC::Input::MARC' );
  14 }
  15
  16 my $debug = shift @ARGV;
  17 my $no_log = $debug ? 0 : 1;
  18
  19 ok(my $abs_path = abs_path($0), "abs_path");
  20 $abs_path =~ s#/[^/]*$#/#;
  21
  22 my $module = 'WebPAC::Input::ISIS';
  23 diag "testing with $module";
  24
  25 throws_ok { my $input = new WebPAC::Input( ) } qr/module/, "need module";
  26 ok(my $input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1, stats => 1 ), "new $module");
  27 ok(my $input_lm = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module");
  28
  29 throws_ok { $input->open( ) } qr/path/, "need path";
  30
  31 throws_ok { $input->open( path => '/dev/null', ) } qr/can't find database/ , "open";
  32
  33 my $store;
  34
  35 ok($input->open( path => "$abs_path/winisis/BIBL" ), "open winisis");
  36 ok($input_lm->open(
  37         path => "$abs_path/winisis/BIBL",
  38         save_row => sub {
  39                 my $a = shift;
  40                 $store->{ $a->{id} } = $a->{row};
  41         },
  42         load_row => sub {
  43                 my $a = shift;
  44                 return defined($store->{ $a->{id} }) &&
  45                         $store->{ $a->{id} };
  46         },
  47 ), "open winisis");
  48
  49 cmp_ok( keys %$store, '==', 5, 'have 5 rows');
  50
  51 foreach my $i ( 1 .. 5 ) {
  52         ok(my $r = $store->{$i}, "row $i");
  53         ok($r->{'000'}, "have 000");
  54         isa_ok($r->{'000'}, 'ARRAY', "is ARRAY");
  55         cmp_ok($r->{'000'}->[0], '==', $i, 'sane value');
  56 }
  57
  58 diag "store = ",dump( $store ) if ($debug);
  59
  60 sub test_after_open($) {
  61         my $input = shift;
  62
  63         cmp_ok($input->pos, '==', -1, "mfn");
  64         ok(my $size = $input->size, "size");
  65         return $size;
  66 }
  67
  68 test_after_open($input);
  69 my $size = test_after_open($input_lm);
  70
  71 sub test_fetch($$) {
  72         my ($input, $size) = @_;
  73
  74         my @db;
  75
  76         foreach my $mfn ( 1 ... $size ) {
  77                 ok(my $rec = $input->fetch, "fetch $mfn");
  78                 cmp_ok($input->pos, '==', $mfn, "pos $mfn");
  79                 push @db, $rec;
  80                 ok(my $dump = $input->dump_ascii, "dump_ascii $mfn");
  81                 diag $dump if ($debug);
  82         }
  83
  84         return @db;
  85 }
  86
  87 my @db1 = test_fetch($input, $size);
  88 my @db2 = test_fetch($input_lm, $size);
  89
  90 is_deeply(\@db1, \@db2, "seek working");
  91
  92 sub test_start_limit($$$$) {
  93         my ($input, $s,$l,$e) = @_;
  94
  95         diag "offset $s, limit: $l, expected: $e";
  96
  97         ok($s = $input->open( path => "$abs_path/winisis/BIBL", offset => $s, limit => $l, debug => $debug ), "open winisis");
  98         cmp_ok($s, '==', $size, "db size from open = $size");
  99         cmp_ok($input->size, '==', $e, "input->size = $e");
 100 }
 101
 102 test_start_limit($input, 1, 3, 3);
 103 test_start_limit($input, $size, 3, 0);
 104 test_start_limit($input, 3, $size, $size - 2);
 105 test_start_limit($input, 1, $size + 2, $size);
 106
 107 ok(my $s = $input->stats, 'stats');
 108 diag "stats:\n$s";
 109
 110 $module = 'WebPAC::Input::MARC';
 111 diag "testing with $module";
 112
 113 ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module");
 114
 115 ok($input->open( path => "$abs_path/data/marc.iso" ), "open marc.iso");
 116
 117 test_after_open($input);
 118
 119 test_fetch($input, $input->size);
 120
 121 # test modify_record
 122 $module = 'WebPAC::Input::ISIS';
 123 ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module");
 124
 125 ok($input->open( path => "$abs_path/modify_isis/LIBRI", ), "open modify_isis (plain)");
 126 ok(my $rec_p = $input->fetch, 'fetch');
 127
 128 # modify_records
 129
 130 ok($input->open(
 131         path => "$abs_path/modify_isis/LIBRI",
 132         modify_records => {
 133                 200 => {
 134                         '*' => { '^c' => '. ' },
 135                 }
 136         },
 137 ), "open modify_isis (with modify_records)");
 138
 139 ok(my $rec = $input->fetch, 'fetch');
 140
 141 cmp_ok($rec_p->{200}->[0]->{f} . '. ' . $rec_p->{200}->[0]->{c}, 'eq' ,$rec->{200}->[0]->{f}, 'modify_records working');
 142
 143 diag dump($input);
 144
 145 # break encapsulation, bad! bad!
 146 $input->{ll_db}->{record} = {
 147         900 => 'foo ; bar ; baz',
 148 };
 149
 150 $input->{modify_record} = {
 151         900 => {
 152                 '*' => {
 153                         ' ; ' => 'a',
 154                 }
 155         }
 156 };
 157
 158 diag "hacked: ",dump($input, $input->fetch);