--- trunk/t/2-input.t 2006/11/03 20:40:33 771 +++ trunk/t/2-input.t 2007/10/29 23:20:13 908 @@ -1,6 +1,6 @@ #!/usr/bin/perl -w -use Test::More tests => 104; +use Test::More tests => 123; use Test::Exception; use Cwd qw/abs_path/; use blib; @@ -11,18 +11,19 @@ BEGIN { use_ok( 'WebPAC::Input::ISIS' ); use_ok( 'WebPAC::Input::MARC' ); +use_ok( 'WebPAC::Input::Test' ); } my $debug = shift @ARGV; my $no_log = $debug ? 0 : 1; ok(my $abs_path = abs_path($0), "abs_path"); -$abs_path =~ s#/[^/]*$#/#; +$abs_path =~ s#/[^/]*$#/#; #vim my $module = 'WebPAC::Input::ISIS'; diag "testing with $module"; -throws_ok { my $input = new WebPAC::Input( ) } qr/module/, "need module"; +throws_ok { my $input = new WebPAC::Input( no_log => $no_log ) } qr/module/, "need module"; ok(my $input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1, stats => 1 ), "new $module"); ok(my $input_lm = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module"); @@ -77,7 +78,9 @@ ok(my $rec = $input->fetch, "fetch $mfn"); cmp_ok($input->pos, '==', $mfn, "pos $mfn"); push @db, $rec; - ok(my $dump = $input->dump, "dump $mfn"); + ok(my $dump = $input->dump_ascii, "dump_ascii $mfn"); + # XXX test count will help us keep this test in-line :-) + ok($rec->{leader}, "leader $mfn") if $rec->{leader}; diag $dump if ($debug); } @@ -105,7 +108,7 @@ test_start_limit($input, 1, $size + 2, $size); ok(my $s = $input->stats, 'stats'); -diag "stats:\n$s"; +diag "stats:\n$s" if ($debug); $module = 'WebPAC::Input::MARC'; diag "testing with $module"; @@ -119,22 +122,97 @@ test_fetch($input, $input->size); # test modify_record -$module = 'WebPAC::Input::ISIS'; -ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1 ), "new $module"); +$module = 'WebPAC::Input::Test'; +ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1, debug => $debug ), "new $module"); + +$WebPAC::Input::Test::rec = { + '200' => [ + { 'a' => '[200 a]', 'b' => '[200 b]', 'c' => '[200 c]', 'f' => '[200 f] test : test' }, + ], + '900' => [ + { 'x' => 'foobar', }, + ], +}; + +$WebPAC::Input::Test::size = 42; + +ok($input->open( path => "/fake/path", ), "open modify_isis (plain)"); + +cmp_ok($input->size, '==', 42, 'size'); -ok($input->open( path => "$abs_path/modify_isis/LIBRI", ), "open modify_isis (plain)"); ok(my $rec_p = $input->fetch, 'fetch'); +# modify_records + ok($input->open( - path => "$abs_path/modify_isis/LIBRI", + path => "/another/fake/path", modify_records => { 200 => { '*' => { '^c' => '. ' }, + '^f' => { ' : ' => ' / ' }, } }, -), "open modify_isis (with modify_records)"); +), "open (with modify_records)"); + +# seek +throws_ok { $input->seek } qr/without/, 'seek without position'; +cmp_ok($input->seek(0), '==', -1, 'seek'); + +sub test_filter { -ok(my $rec = $input->fetch, 'fetch'); + my $f = $WebPAC::Input::Test::filter_coderef; + ok(ref($f) eq 'CODE', 'filter_coderef'); + + my ($field, $from, $to) = @_; + cmp_ok( $f->( $from, $field, 1 ), 'eq', $to, "filter $field |$from| -> |$to|" ); +} -cmp_ok($rec_p->{200}->[0]->{f} . '. ' . $rec_p->{200}->[0]->{c}, 'eq' ,$rec->{200}->[0]->{f}, 'modify_records working'); +test_filter(200, + '^afoo^cbar^fbing : bong', + '^afoo. bar^fbing / bong', +); + +# modify_file + +my $modify_file = "$abs_path/conf/modify/test.pl"; + +ok($input->open( + path => "/and/another/fake/path", + modify_file => $modify_file, +), "open (with modify_file $modify_file)"); + +diag "regexps = ", dump($input->modify_file_regexps( $modify_file )) if ($debug); + +test_filter(200, + '^a foo ; bar = baz : zzz', + '^a foo^kbar^dbaz : zzz', +); + +# empty subfield removal + +ok($input->open( + path => "/another/fake/path", + modify_records => { + 900 => { + '^a' => { '^e' => ' : ^e' }, + }, + 901 => { + '^a' => { 'foo' => 'baz' }, + }, + }, +), "open (with modify_records for empty subfields)"); +test_filter(900, + '^a^ebar', + '^a^ebar', +); + +test_filter(900, + '^afoo^ebar', + '^afoo : ^ebar', +); + +test_filter(901, + '^afoo^ebar', + '^abaz^ebar', +);