X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=t%2F3-normalize.t;h=76acb045b04b1a6f34e6fbd1bda8bb9629d9e94d;hb=HEAD;hp=ee0c802cfa9b4baed66b0078914250dfcd26c966;hpb=11115607fe1bd1526f08618a3e906fad2a675c06;p=webpac2 diff --git a/t/3-normalize.t b/t/3-normalize.t index ee0c802..76acb04 100755 --- a/t/3-normalize.t +++ b/t/3-normalize.t @@ -1,9 +1,11 @@ #!/usr/bin/perl -w use strict; -use blib; +use lib 'lib'; -use Test::More tests => 351; +use Test::More tests => 364; + +use utf8; BEGIN { use_ok( 'WebPAC::Test' ); @@ -55,7 +57,7 @@ my $rec2 = { } ], '700' => [ { 'a' => 'Haynal', - 'b' => 'André' + 'b' => 'André' } ], '801' => [ 'FFZG' ], '991' => [ '8302' ], @@ -78,7 +80,7 @@ my $rec2 = { 'e' => 'from Freud and Ferenczi to Michael balint', 'a' => 'Controversies in psychoanalytic method', 'g' => 'translated by Elizabeth Holder on the basisi of a first draft by Archie Hooton ; with a preface by Daniel N. Stern', - 'f' => 'by André E. Haynal' + 'f' => 'by André E. Haynal' } ], '610' => [ 'povijest psihoanalize' ], '994' => [ { @@ -485,7 +487,7 @@ sub test_s { test_s(qq{ marc_indicators('900',1,2) }); test_s(qq{ marc('900','a', rec('200') ) }); my $marc; - ok($marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields"); + ok($marc = WebPAC::Normalize::MARC::_get_marc_fields(), "_get_marc_fields"); diag dump( $marc ) if ($debug); is_deeply( $marc, [ @@ -496,7 +498,7 @@ sub test_s { test_s(qq{ marc_indicators('900',' ',9) }); test_s(qq{ marc_repeatable_subfield('900','a', rec('200') ) }); - ok($marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields"); + ok($marc = WebPAC::Normalize::MARC::_get_marc_fields(), "_get_marc_fields"); diag dump( $marc ) if ($debug); is_deeply( $marc, [ @@ -522,8 +524,8 @@ sub test_s { test_s($r) if ($r); } - ok(my $marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields"); - diag dump( $marc ) if ($debug); + ok(my $marc = WebPAC::Normalize::MARC::_get_marc_fields(), "_get_marc_fields"); + diag dump( $marc ) if $debug; diag "expects:\n", dump($struct) if ($debug > 1); is_deeply( $marc, $struct, $msg ); } @@ -732,7 +734,7 @@ sub test_s { ); test_s(qq{ marc_remove('*'); }); - ok(! WebPAC::Normalize::_get_marc_fields(), 'marc_remove(*)'); + ok(! WebPAC::Normalize::MARC::_get_marc_fields(), 'marc_remove(*)'); test_rec_rules( 'marc_duplicate', @@ -766,7 +768,7 @@ sub test_s { my $i = 0; foreach my $v ( qw/bar baz bing bong/ ) { - ok($marc = WebPAC::Normalize::_get_marc_fields( offset => $i ), + ok($marc = WebPAC::Normalize::MARC::_get_marc_fields( offset => $i ), "_get_marc_fields( offset => $i )" ); diag "marc $i = ", dump( $marc ) if ($debug); @@ -774,7 +776,7 @@ sub test_s { [ [ '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"); + is_deeply(WebPAC::Normalize::MARC::_get_marc_leader(), { '06' => 42, 11 => $i }, "_get_marc_leader copy $i"); $i++; } @@ -798,6 +800,27 @@ sub test_s { ], ); + test_rec_rules( + 'marc_original_order and marc_indicators', + { + '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); + marc_indicators(900,1,2); + }, + [ + [ '900', '1', '2', 'a', 'a1', 'b', 'b1', 'a', 'a2', 'b', 'b2', 'c', 'c1', 'c', 'c2', ], + [ '900', '1', '2', 'a', 'a3', 'a', 'a4', 'b', 'b3', 'c', 'c3', 'a', 'a5', ], + ], + ); + test_rule( 'rec1 skips subfields', { @@ -841,9 +864,9 @@ sub test_s { marc_fixed('000', 10, 'A'); marc_fixed('000', 0, '0'); }); - ok( my $m = WebPAC::Normalize::_get_marc_fields(), '_get_marc_fields'); + ok( my $m = WebPAC::Normalize::MARC::_get_marc_fields(), '_get_marc_fields'); diag dump( $m ); - is_deeply( WebPAC::Normalize::_get_marc_fields(), + is_deeply( WebPAC::Normalize::MARC::_get_marc_fields(), [ ["008", "abcdef"], # 0....5....10 @@ -864,69 +887,65 @@ sub test_s { [ '1-55860-701-3', '1-55860-701-3' ], 'isbn_10' ); - # marc_template + # frec - 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"], - ], - ], + $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/ ], + i1 => '0', i2 => '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' ] ); + test_rule( 'frec', $rec, qq{ frec(200,'i1') }, [ '0' ] ); + test_rule( 'frec', $rec, qq{ frec(200,'i2') }, [ '1' ] ); + + $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"); + } + + test_rule( 'rec(200,i1)', $rec, qq{ rec(200,'i1') }, [ '0' ] ); + test_rule( 'rec(200,i2)', $rec, qq{ rec(200,'i2') }, [ '1' ] ); + + my $hash = { a => '[a]', 'b' => '[b]', subfields => [ 'a', 0, 'b', 0 ] }; + is_deeply([ _pack_subfields_hash( $hash ) ], [ '[a]', '[b]' ], '_pack_subfields_hash' ); + ok( $hash->{subfields}, 'subfields exist' ); + cmp_ok( _pack_subfields_hash( $hash, 1 ), 'eq', '^a[a]^b[b]', '_pack_subfields_hash' ); + ok( $hash->{subfields}, 'subfields exist' ); + + $rec = { 'arr' => [ 1, 2, 3 ] }; + test_rule( 'rec_array', $rec, qq{ rec_array('arr') }, $rec->{arr} ); + + _clean_ds(); + _set_ds( $rec ); + test_s(q{ + row( 'table', e => $_ ) foreach ( rec_array('arr') ); + }); + ok( my $rows = _get_ds->{_rows}->{table}, 'ds have _rows' ); + + foreach my $i ( 1 .. 3 ) { + cmp_ok( $rows->[ $i - 1 ]->{e}, '==', $i, "e $i" ); + } + + test_rule( 'utf-8' + , { '900' => [{ a => 'Čev', b => 'ić' }] } + , qq{ join_with('', rec(900,'a'), 'apč', rec(900,'b') ) } + , [ "\x{10C}evap\x{10D}i\x{107}" ] ); + }