--- trunk/t/3-normalize.t 2006/09/11 14:29:01 669 +++ trunk/t/3-normalize.t 2007/10/31 00:26:43 923 @@ -2,7 +2,7 @@ use strict; -use Test::More tests => 157; +use Test::More tests => 347; use Test::Exception; use Cwd qw/abs_path/; use blib; @@ -32,8 +32,6 @@ $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 +107,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(@_) ); @@ -177,21 +191,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 +364,23 @@ # test lookups - _set_lookup( $lookup2 ); + _set_lookup( $lookup_hash2 ); + + throws_ok { lookup() } qr/need/, 'empty lookup'; - is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' ); + #is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' ); - ok(! lookup('non-existent'), 'lookup non-existant' ); + #ok(! lookup('non-existent'), 'lookup non-existant' ); _set_rec( $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 +431,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"; @@ -329,7 +465,6 @@ is_deeply( $ds, { 'mixed' => { 'search' => [ '200a', '200b' ], - 'tag' => 'mixed' } }, 'correct get_ds'); @@ -353,14 +488,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') ) }); @@ -609,19 +743,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 +774,8 @@ ], ); + cmp_ok( marc_count(), '==', 3, 'marc_count' ); + my $i = 0; foreach my $v ( qw/bar baz bing bong/ ) { @@ -642,6 +787,7 @@ [ [ '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++; } @@ -700,5 +846,22 @@ '^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"] + ] + ); }