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

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use blib;
   5
   6 use Test::More tests => 124;
   7
   8 BEGIN {
   9 use_ok( 'WebPAC::Test' );
  10 use_ok( 'WebPAC::Input::ISIS' );
  11 use_ok( 'WebPAC::Input::MARC' );
  12 use_ok( 'WebPAC::Input::Test' );
  13 }
  14
  15 $LOG{no_progress_bar} = 1;
  16
  17 warn "# LOG = ",dump( %LOG );
  18
  19 my $module = 'WebPAC::Input::ISIS';
  20 diag "testing with $module";
  21
  22 throws_ok { my $input = new WebPAC::Input( %LOG ) } qr/module/, "need module";
  23 ok(my $input = new WebPAC::Input( module => $module, stats => 1, \%LOG ), "new $module");
  24 ok(my $input_lm = new WebPAC::Input( module => $module, \%LOG ), "new $module");
  25
  26 throws_ok { $input->open( ) } qr/path/, "need path";
  27
  28 throws_ok { $input->open( path => '/dev/null', ) } qr/can't find database/ , "open";
  29
  30 my $store;
  31
  32 ok($input->open( path => "$abs_path/winisis/BIBL" ), "open winisis");
  33 ok($input_lm->open(
  34         path => "$abs_path/winisis/BIBL",
  35         save_row => sub {
  36                 my $a = shift;
  37                 $store->{ $a->{id} } = $a->{row};
  38         },
  39         load_row => sub {
  40                 my $a = shift;
  41                 return defined($store->{ $a->{id} }) &&
  42                         $store->{ $a->{id} };
  43         },
  44 ), "open winisis");
  45
  46 cmp_ok( keys %$store, '==', 5, 'have 5 rows');
  47
  48 foreach my $i ( 1 .. 5 ) {
  49         ok(my $r = $store->{$i}, "row $i");
  50         ok($r->{'000'}, "have 000");
  51         isa_ok($r->{'000'}, 'ARRAY', "is ARRAY");
  52         cmp_ok($r->{'000'}->[0], '==', $i, 'sane value');
  53 }
  54
  55 diag "store = ",dump( $store ) if ($debug);
  56
  57 sub test_after_open($) {
  58         my $input = shift;
  59
  60         cmp_ok($input->pos, '==', -1, "mfn");
  61         ok(my $size = $input->size, "size");
  62         return $size;
  63 }
  64
  65 test_after_open($input);
  66 my $size = test_after_open($input_lm);
  67
  68 sub test_fetch($$) {
  69         my ($input, $size) = @_;
  70
  71         my @db;
  72
  73         foreach my $mfn ( 1 ... $size ) {
  74                 ok(my $rec = $input->fetch, "fetch $mfn");
  75                 cmp_ok($input->pos, '==', $mfn, "pos $mfn");
  76                 push @db, $rec;
  77                 ok(my $dump = $input->dump_ascii, "dump_ascii $mfn");
  78                 # XXX test count will help us keep this test in-line :-)
  79                 ok($rec->{leader}, "leader $mfn") if $rec->{leader};
  80                 diag $dump if ($debug);
  81         }
  82
  83         return @db;
  84 }
  85
  86 my @db1 = test_fetch($input, $size);
  87 my @db2 = test_fetch($input_lm, $size);
  88
  89 is_deeply(\@db1, \@db2, "seek working");
  90
  91 sub test_start_limit($$$$) {
  92         my ($input, $s,$l,$e) = @_;
  93
  94         diag "offset $s, limit: $l, expected: $e";
  95
  96         ok($s = $input->open( path => "$abs_path/winisis/BIBL", offset => $s, limit => $l, debug => $debug ), "open winisis");
  97         cmp_ok($s, '==', $size, "db size from open = $size");
  98         cmp_ok($input->size, '==', $e, "input->size = $e");
  99 }
 100
 101 test_start_limit($input, 1, 3, 3);
 102 test_start_limit($input, $size, 3, 0);
 103 test_start_limit($input, 3, $size, $size - 2);
 104 test_start_limit($input, 1, $size + 2, $size);
 105
 106 ok(my $s = $input->stats, "$module stats");
 107 diag "stats:\n$s" if ($debug);
 108
 109 $module = 'WebPAC::Input::MARC';
 110 diag "testing with $module";
 111
 112 ok($input = new WebPAC::Input( module => $module, stats => 1, %LOG ), "new $module");
 113
 114 ok($input->open( path => "$abs_path/data/marc.iso" ), "open marc.iso");
 115
 116 test_after_open($input);
 117
 118 test_fetch($input, $input->size);
 119
 120 ok(my $s = $input->stats, "$module stats");
 121
 122 diag "stats:\n$s" if ($debug);
 123 # test modify_record
 124 $module = 'WebPAC::Input::Test';
 125 ok($input = new WebPAC::Input( module => $module, %LOG ), "new $module");
 126
 127 $WebPAC::Input::Test::rec = {
 128         '200' => [
 129                 { 'a' => '[200 a]', 'b' => '[200 b]', 'c' => '[200 c]', 'f' => '[200 f] test : test' },
 130         ],
 131         '900' => [
 132                 { 'x' => 'foobar', },
 133         ],
 134 };
 135
 136 $WebPAC::Input::Test::size = 42;
 137
 138 ok($input->open( path => "/fake/path", ), "open modify_isis (plain)");
 139
 140 cmp_ok($input->size, '==', 42, 'size');
 141
 142 ok(my $rec_p = $input->fetch, 'fetch');
 143
 144 # modify_records
 145
 146 ok($input->open(
 147         path => "/another/fake/path",
 148         modify_records => {
 149                 200 => {
 150                         '*' => { '^c' => '. ' },
 151                         '^f' => { ' : ' => ' / ' },
 152                 }
 153         },
 154 ), "open (with modify_records)");
 155
 156 # seek
 157 throws_ok { $input->seek } qr/without/, 'seek without position';
 158 cmp_ok($input->seek(0), '==', -1, 'seek');
 159
 160 sub test_filter {
 161
 162         my $f = $WebPAC::Input::Test::filter_coderef;
 163         ok(ref($f) eq 'CODE', 'filter_coderef');
 164
 165         my ($field, $from, $to) = @_;
 166         cmp_ok( $f->( $from, $field, 1 ), 'eq', $to, "filter $field |$from| -> |$to|" );
 167 }
 168
 169 test_filter(200,
 170         '^afoo^cbar^fbing : bong',
 171         '^afoo. bar^fbing / bong',
 172 );
 173
 174 # modify_file
 175
 176 my $modify_file = "$abs_path/conf/modify/test.pl";
 177
 178 ok($input->open(
 179         path => "/and/another/fake/path",
 180         modify_file => $modify_file,
 181 ), "open (with modify_file $modify_file)");
 182
 183 diag "regexps = ", dump($input->modify_file_regexps( $modify_file )) if ($debug);
 184
 185 test_filter(200,
 186         '^a foo ; bar = baz : zzz',
 187         '^a foo^kbar^dbaz : zzz',
 188 );
 189
 190 # empty subfield removal
 191
 192 ok($input->open(
 193         path => "/another/fake/path",
 194         modify_records => {
 195                 900 => {
 196                         '^a' => { '^e' => ' : ^e' },
 197                 },
 198                 901 => {
 199                         '^a' => { 'foo' => 'baz' },
 200                 },
 201         },
 202 ), "open (with modify_records for empty subfields)");
 203
 204 test_filter(900,
 205         '^a^ebar',
 206         '^a^ebar',
 207 );
 208
 209 test_filter(900,
 210         '^afoo^ebar',
 211         '^afoo : ^ebar',
 212 );
 213
 214 test_filter(901,
 215         '^afoo^ebar',
 216         '^abaz^ebar',
 217 );