--- trunk/t/3-normalize.t 2006/07/23 20:19:56 603 +++ trunk/t/3-normalize.t 2007/11/08 17:19:50 1015 @@ -1,25 +1,15 @@ #!/usr/bin/perl -w use strict; - -use Test::More tests => 150; -use Test::Exception; -use Cwd qw/abs_path/; use blib; -use File::Slurp; -use Getopt::Long; + +use Test::More tests => 351; BEGIN { + use_ok( 'WebPAC::Test' ); use_ok( 'WebPAC::Normalize' ); } -use Data::Dump qw/dump/; - -my $debug = 0; -GetOptions( - "debug+", \$debug -); - cmp_ok(_debug(1), '==', 1, '_debug level'); cmp_ok(_debug(0), '==', 0, '_debug level'); @@ -28,12 +18,6 @@ diag "debug level for WebPAC::Normalize is ", _debug( $debug - 2 ); } -ok(my $abs_path = abs_path($0), "abs_path"); -$abs_path =~ s#/[^/]*$#/#; -diag "abs_path: $abs_path" if ($debug); - -#throws_ok { new WebPAC::Normalize::XML( lookup_regex => 'foo' ) } qr/pair/, "lookup_regex without lookup"; - my $rec1 = { '200' => [{ 'a' => '200a', @@ -109,18 +93,34 @@ }; -my $lookup1 = { - '00900' => [ - 'lookup 1', - 'lookup 2', - ], +my $lookup_hash1 = { + 'db1' => { + 'input1' => { + 'key1' => { 1 => 1 }, + 'key2' => { 2 => 1 }, + }, + 'input2' => { + 'key3' => { 3 => 1 }, + 'key4' => { 4 => 1 }, + }, + }, + 'db2' => { + 'input3' => { + 'key5' => { 5 => 1 }, + 'key6' => { 6 => 1 }, + }, + } }; -my $lookup2 = { - '00900' => 'lookup', +my $lookup_hash2 = { + 'db3' => { + 'input4' => { + 'key7' => { 7 => 1 }, + 'key8' => { 8 => 1 }, + }, + } }; - sub test { print dump( @_ ), ("-" x 78), "\n"; ok( defined(@_) ); @@ -162,7 +162,7 @@ ok(! _set_lookup( undef ), "set_lookup(undef)"); - _set_rec( $rec1 ); + _set_ds( $rec1 ); cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' ); cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b', 'join rec2 rec2' ); @@ -177,21 +177,136 @@ # simple list manipulatons cmp_ok( join('', prefix('ab', 'cd') ), 'eq', 'abcd', 'prefix'); + cmp_ok( join('-', prefix('', 'x', 'y') ), 'eq', 'x-y', 'prefix empty'); + cmp_ok( join('-', prefix(0, 'x', 'y') ), 'eq', '0x-0y', 'prefix 0'); + cmp_ok( join('', suffix('xy', 'cd') ), 'eq', 'cdxy', 'suffix'); + cmp_ok( join('-', suffix('', 'x', 'y' ) ), 'eq', 'x-y', 'suffix empty'); + cmp_ok( join('-', suffix(0, 'x', 'y' ) ), 'eq', 'x0-y0', 'suffix 0'); + cmp_ok( join('', surround('->', '<-', 'a','b','c') ), 'eq', '->a<-->b<-->c<-', 'surround'); + cmp_ok( join('-', surround('', '', 'x','y','z') ), 'eq', 'x-y-z', 'surround empty'); + cmp_ok( join('-', surround(0, 0, 'x','y','z') ), 'eq', '0x0-0y0-0z0', 'surround 0 0'); + + # count + my @el; + for my $i ( 0 .. 10 ) { + cmp_ok( count( @el ), '==', $i, "count($i)"); + push @el, "element $i"; + } + + # lookups + + throws_ok { _set_load_row() } qr/CODE/, 'empty _set_load_row()'; + + ok(_set_load_row(sub { + my ($database,$input,$mfn) = @_; + diag "load_row( $database, $input, $mfn )" if ($debug); + cmp_ok( $#_, '==', 2, 'have 3 arguments'); + ok($database, '_load_row database'); + ok($input, '_load_row input'); + ok($mfn, '_load_row mfn'); + return { + '900' => [{ x => '900x-' . $mfn , y => '900y-' . $mfn }], + } + + }), '_set_load_row'); + + my @v = qw/foo bar baz aaa bbb ccc ddd/; + + my @accumulated; + + for my $i ( 0 .. $#v ) { + + my $mfn = 1000 + $i; + + ok(WebPAC::Normalize::_set_config({ '_mfn' => $mfn }), "_set_config _mfn=$mfn"); + + my $size = $#v + 1; + + cmp_ok( + save_into_lookup('db','input','key', sub { @v }), + '==', $size, "save_into_lookup $size values" + ); + + ok(my $l = WebPAC::Normalize::_get_lookup(), '_get_lookup'); + diag "_get_lookup = ", dump($l) if ($debug); + + my @lookup; + + ok(@lookup = lookup( + sub { + diag "in show" if ($debug); + rec('900','x'); + }, + 'db','input','key', + sub { + return @v; + } + ), + "lookup db/input/key"); + + push @accumulated, '900x-' . $mfn; + + is_deeply(\@lookup, \@accumulated, "lookup db/input/key"); + + shift @v; + + } + + ok(my $l = WebPAC::Normalize::_get_lookup(), '_get_lookup'); + diag "_get_lookup = ", dump($l) if ($debug); + + is_deeply( $l, { + db => { + input => { + key => { + foo => { 1000 => 1 }, + bar => { 1000 => 1, 1001 => 1 }, + baz => { 1000 => 1, 1001 => 1, 1002 => 1 }, + aaa => { 1000 => 1, 1001 => 1, 1002 => 1, 1003 => 1 }, + bbb => { 1000 => 1, 1001 => 1, 1002 => 1, 1003 => 1, 1004 => 1 }, + ccc => { 1000 => 1, 1001 => 1, 1002 => 1, 1003 => 1, 1004 => 1, 1005 => 1 }, + ddd => { 1000 => 1, 1001 => 1, 1002 => 1, 1003 => 1, 1004 => 1, 1005 => 1, 1006 => 1 }, + }, + }, + }, + }, 'lookup data'); + +####### + + diag "lookup_hash1 = ", dump($lookup_hash1) if ($debug); + ok(_set_lookup( $lookup_hash1 ), '_set_lookup $lookup_hash1'); + + throws_ok { _set_load_row() } qr/CODE/, 'empty _set_load_row()'; + + ok(_set_load_row(sub { + my ($database,$input,$mfn) = @_; + diag "load_row( $database, $input, $mfn )"; + cmp_ok( $#_, '==', 2, 'have 3 arguments'); + ok($database, 'database'); + ok($input, 'input'); + ok($mfn, 'mfn'); + + }), '_set_load_row'); + + +# cmp_ok(lookup( +# sub { +# 'found' +# }, +# 'db1','input1','key1', +# sub { +# rec('200','a') +# } +# ), 'eq', 'found', 'lookup db1/input1/key1'); - _set_lookup( $lookup1 ); - cmp_ok( - join_with(" i ", - lookup( - regex( 's/^/00/', - rec2('902','z') - ) - ) - ), - 'eq', 'lookup 1 i lookup 2', 'join lookup regex rec2'); +# cmp_ok( +# lookup( +# ), +# 'eq', 'lookup 1 i lookup 2', 'join lookup regex rec2'); # check join_with operations @@ -235,21 +350,23 @@ # test lookups - _set_lookup( $lookup2 ); + _set_lookup( $lookup_hash2 ); - is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' ); + throws_ok { lookup() } qr/need/, 'empty lookup'; - ok(! lookup('non-existent'), 'lookup non-existant' ); + #is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' ); - _set_rec( $rec2 ); + #ok(! lookup('non-existent'), 'lookup non-existant' ); + + _set_ds( $rec2 ); test_s(qq{ - tag('Title', + search_display('Title', rec('200','a') ); }); test_s(qq{ - tag('Who', + search_display('Who', join_with(" ", rec('702','a'), rec('702','b') @@ -300,12 +417,17 @@ test_check_ds('display'); _clean_ds(); - test_s(qq{ tag('something', '42'); }); - test_s(qq{ tag('empty', ''); }); + test_s(qq{ search_display('something', '42'); }); + test_s(qq{ search_display('empty', ''); }); test_check_ds('search'); test_check_ds('display'); _clean_ds(); + test_s(qq{ sorted('something', '42'); }); + test_s(qq{ sorted('empty', ''); }); + test_check_ds('sorted'); + + _clean_ds(); my $n = read_file( "$abs_path/data/normalize.pl" ); $n .= "\n1;\n"; #diag "normalize code:\n$n\n"; @@ -323,13 +445,12 @@ my $rules = qq{ search('mixed', rec('200') ) }; _clean_ds(); - _set_rec( $rec ); + _set_ds( $rec ); test_s( $rules ); ok($ds = _get_ds(), "get_ds"); is_deeply( $ds, { 'mixed' => { 'search' => [ '200a', '200b' ], - 'tag' => 'mixed' } }, 'correct get_ds'); @@ -341,7 +462,7 @@ # wird and non-valid structure which is supported anyway _clean_ds(); - _set_rec({ + _set_ds({ '200' => [{ 'a' => '200a', }, @@ -353,14 +474,13 @@ is_deeply( $ds, { 'mixed' => { 'search' => [ '200a', '200-solo' ], - 'tag' => 'mixed' } }, 'correct get_ds'); # # MARC # - _debug( 4 ); + #_debug( 4 ); test_s(qq{ marc_indicators('900',1,2) }); test_s(qq{ marc('900','a', rec('200') ) }); @@ -392,12 +512,13 @@ my ($msg, $rec, $rules, $struct) = @_; _clean_ds(); - _set_rec($rec); + _set_ds($rec); - foreach my $r (split(/;/, $rules)) { + foreach my $r (split(/;\s*$/, $rules)) { $r =~ s/[\s\n\r]+/ /gs; $r =~ s/^\s+//gs; $r =~ s/\s+$//gs; + diag "rule: $r" if $debug; test_s($r) if ($r); } @@ -501,7 +622,7 @@ sub test_rule { my ($msg, $rec, $rule, $struct) = @_; _clean_ds(); - _set_rec( $rec ); + _set_ds( $rec ); $rule =~ s/\\/\\/gs; my $r = test_s( $rule ); diag "for ", dump($rec), " got:\n", dump($r), "\nexpect:\n" if ($debug > 1); @@ -609,19 +730,28 @@ [ '901', ' ', ' ', 'b', 'bar', 'c', 'baz' ], ], ); + + test_s(qq{ marc_remove('*'); }); + ok(! WebPAC::Normalize::_get_marc_fields(), 'marc_remove(*)'); + test_rec_rules( 'marc_duplicate', { '200' => [{ a => 42, b => 'bar', c => 'baz', d => 'bing', e => 'bong' }] }, qq{ + marc_leader('06',42); + marc_leader('11',0); marc('900', 'a', rec('200','a') ); marc('900', 'b', rec('200','b') ); marc_duplicate; + marc_leader('11',1); marc_remove('900','b'); marc('900', 'b', rec('200','c') ); marc_duplicate; + marc_leader('11',2); marc_remove('900','b'); marc('900', 'b', rec('200','d') ); marc_duplicate; + marc_leader('11',3); marc_remove('900','b'); marc('900', 'b', rec('200','e') ); }, @@ -631,6 +761,8 @@ ], ); + cmp_ok( marc_count(), '==', 3, 'marc_count' ); + my $i = 0; foreach my $v ( qw/bar baz bing bong/ ) { @@ -642,7 +774,187 @@ [ [ '900', ' ', ' ', 'a', 42, 'b', $v ] ], "MARC copy $i has $v", ); + is_deeply(WebPAC::Normalize::_get_marc_leader(), { '06' => 42, 11 => $i }, "_get_marc_leader copy $i"); $i++; } + + test_rec_rules( + 'marc_original_order', + { + '200' => [ { + a => [ 'a1', 'a2' ], b => [ 'b1', 'b2' ], c => [ 'c1', 'c2' ], + subfields => [ qw/a 0 b 0 a 1 b 1 c 0 c 1/ ], + }, { + a => [ 'a3', 'a4', 'a5' ], b => 'b3', c => 'c3', + subfields => [ qw/a 0 a 1 b 0 c 0 a 2/ ], + } ], + }, + qq{ + marc_original_order(900,200); + }, + [ + [ '900', ' ', ' ', 'a', 'a1', 'b', 'b1', 'a', 'a2', 'b', 'b2', 'c', 'c1', 'c', 'c2', ], + [ '900', ' ', ' ', 'a', 'a3', 'a', 'a4', 'b', 'b3', 'c', 'c3', 'a', 'a5', ], + ], + ); + + test_rule( + 'rec1 skips subfields', + { + '200' => [ { + a => [ 'a1', 'a2' ], b => [ 'b1', 'b2' ], c => [ 'c1', 'c2' ], + subfields => [ qw/a 0 b 0 a 1 b 1 c 0 c 1/ ], + }, { + a => [ 'a3', 'a4', 'a5' ], b => 'b3', c => 'c3', + subfields => [ qw/a 0 a 1 b 0 c 0 a 2/ ], + } ], + }, + qq{ + rec1(200); + }, + ['a1', 'b1', 'a2', 'b2', 'c1', 'c2', 'a3', 'a4', 'b3', 'c3', 'a5' ], + ); + + is_deeply( + [ _pack_subfields_hash({ + a => [ 'a1', 'a2' ], b => [ 'b1', 'b2' ], c => [ 'c1', 'c2' ], + subfields => [ qw/a 0 b 0 a 1 b 1 c 0 c 1/ ], + }) ], + ['a1', 'b1', 'a2', 'b2', 'c1', 'c2'], + '_pack_subfields_hash( $h )' + ); + + cmp_ok( + _pack_subfields_hash({ + a => [ 'a1', 'a2' ], b => [ 'b1', 'b2' ], c => [ 'c1', 'c2' ], + subfields => [ qw/a 0 b 0 a 1 b 1 c 0 c 1/ ], + }, 1), + 'eq', + '^aa1^bb1^aa2^bb2^cc1^cc2', + '_pack_subfields_hash( $h, 1 )' + ); + + _clean_ds(); + test_s(qq{ + marc_fixed('008', 0, 'abcdef'); + marc_fixed('000', 5, '5'); + marc_fixed('000', 10, 'A'); + marc_fixed('000', 0, '0'); + }); + ok( my $m = WebPAC::Normalize::_get_marc_fields(), '_get_marc_fields'); + diag dump( $m ); + is_deeply( WebPAC::Normalize::_get_marc_fields(), + [ + ["008", "abcdef"], + # 0....5....10 + ["000", "0 5 A"] + ] + ); + + test_s(qq{ isbn_13( '1558607013', '978-1558607019' ) }); + test_s(qq{ isbn_10( '1558607013', '978-1558607019' ) }); + + is_deeply( + [ isbn_13( '1558607013', '978-1558607019' ) ], + [ '978-1-55860-701-9', '978-1-55860-701-9', ], + 'isbn_13' ); + + is_deeply( + [ isbn_10( '1558607013', '978-1558607019' ) ], + [ '1-55860-701-3', '1-55860-701-3' ], + 'isbn_10' ); + + # frec + + my $rec = { + '200' => [ { + a => [ 'a1', 'a2' ], b => [ 'b1', 'b2' ], c => [ 'c1', 'c2' ], + subfields => [ qw/a 0 b 0 a 1 b 1 c 0 c 1/ ], + }, { + a => [ 'a3', 'a4', 'a5' ], b => 'b3', c => 'c3', + subfields => [ qw/a 0 a 1 b 0 c 0 a 2/ ], + } ], + }; + + test_rule( 'frec', $rec, qq{ frec(200) }, [ 'a1' ] ); + test_rule( 'frec', $rec, qq{ frec(200,'a') }, [ 'a1' ] ); + test_rule( 'frec', $rec, qq{ frec(200,'b') }, [ 'b1' ] ); + test_rule( 'frec', $rec, qq{ frec(200,'c') }, [ 'c1' ] ); + + $rec->{'900'} = $rec->{'200'}; + foreach my $sf ( qw/a b c/ ) { + ok( frec_eq( '200' => $sf, '900' => $sf ), "frec_eq 200 == 900 $sf"); + ok( ! frec_ne( '200' => $sf, '900' => $sf ), "! frec_ne 200 == 900 $sf"); + } + + foreach my $sf ( qw/a b/ ) { + ok( ! frec_eq( '200' => $sf, '200' => 'c' ), "! frec_eq 200 $sf == 200 c"); + ok( frec_ne( '200' => $sf, '200' => 'c' ), "frec_ne 200 $sf == 200 c"); + } + + # marc_template + + test_rec_rules( + 'marc_template', + { + '225' => [{ + 'a' => 'a-1-1', + 'i' => 'i-1-1', + 'v' => 'v-1-1', + 'w' => 'w-1-1', + 'h' => 'h-1-1', + 'x' => 'x-1-1', + },{ + 'a' => 'a-2-1', + 'v' => 'v-2-1', + 'i' => 'i-2-1', + },{ + 'a' => 'a-3-1', + 'i' => 'i-3-1', + 'v' => 'v-3-1', + },{ + 'a' => 'a-4-1', + 'v' => 'v-4-1', + 'i' => 'i-4-1', + 'w' => 'w-4-1', + }], + }, + qq{ + marc_template( + from => 225, to => 440, + subfields_rename => [ + 'a' => 'a', + 'x' => 'x', + 'v' => 'v', + 'h' => 'n', + 'i' => 'p', + 'w' => 'v', + ], + marc_template => [ + 'a, |x ; |v. |n, |p ; |v', + 'a ; |v. |p ; |v', + 'a. |p ; |v', + ], + ); + }, + [ + [440, " ", " ", + ["a", "a-1-1"], + ["x", "x-1-1"], + ["v", "v-1-1"], + ["n", "h-1-1"], + ["p", "i-1-1"], + ["v", "w-1-1"], + ], + [440, " ", " ", ["a", "a-2-1"], ["p", "i-2-1"], ["v", "v-2-1"]], + [440, " ", " ", ["a", "a-3-1"], ["p", "i-3-1"], ["v", "v-3-1"]], + [440, " ", " ", + ["a", "a-4-1"], + ["v", "v-4-1"], + ["p", "i-4-1"], + ["v", "w-4-1"], + ], + ], + ); }