trunk/t/3-normalize-set.t

#!/usr/bin/perl -w

use strict;

use Test::More tests => 25;
use Test::Exception;
use Cwd qw/abs_path/;
use blib;
use File::Slurp;

use Data::Dumper;
my $debug = 0;

BEGIN {
        use_ok( 'WebPAC::Normalize::Set' );
}

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',
                'b' => '200b',
                },{
                'c' => '200c',
                'd' => '200d',
                },{
                'a' => '200a*2',
                'd' => '200d*2',
                }],
        '201' => [{
                'x' => '201x',
                'y' => '201y',
                }],
        '900' => [
                '900-no_subfield'
                ],
        '901' => [{
                'a' => '900a',
                }],
        '902' => [{
                'z' => '900',
                }],
};

my $rec2 = {
 '675' => [ {
              'a' => '159.9'
            } ],
 '210' => [ {
              'c' => 'New York University press',
              'a' => 'New York',
              'd' => 'cop. 1988'
            } ],
 '700' => [ {
              'a' => 'Haynal',
              'b' => 'André'
            } ],
 '801' => [ 'FFZG' ],
 '991' => [ '8302' ],
 '000' => [ 1 ],
 '702' => [ {
              'a' => 'Holder',
              'b' => 'Elizabeth'
            } ],
 '215' => [ {
              'c' => 'ilustr',
              'a' => 'xix, 202 str',
              'd' => '23cm'
            } ],
 '990' => [
            '2140',
            '88',
            'HAY'
          ],
 '200' => [ {
              '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'
            } ],
 '610' => [ 'povijest psihoanalize' ],
 '994' => [ {
              'c' => '',
              'a' => 'PS',
              'b' => 'MG'
            } ],
 '320' => [ 'Kazalo' ],
 '101' => [ 'ENG' ],
 '686' => [ '2140' ],
 '300' => [ 'Prijevod djela: ' ],
};


my $lookup1 = {
        '00900' => [
                'lookup 1',
                'lookup 2',
        ],
};

my $lookup2 = {
        '00900' => 'lookup',
};


sub test {
        print Dumper( @_ ), ("-" x 78), "\n";
        ok( defined(@_) );
}

sub test_s {
        my $t = shift || die;
        $t =~ s/[\n\r\s]+/ /gs;
        ok(my $v = eval "$t", "eval: $t");
        ok(! $@, $@ ? "error: $@" : "no error");
}

{
        no strict 'subs';
        use WebPAC::Normalize::Set;

        set_rec( $rec1 );

        cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2' );
        cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b' );
        cmp_ok( join(" * ", sort(rec1('200'), rec1('201') )), 'eq', '200a * 200a*2 * 200b * 200c * 200d * 200d*2 * 201x * 201y' );
        is_deeply( \[ rec1('200') ], \[ qw/200a 200b 200c 200d 200a*2 200d*2/ ] );
        is_deeply( \[ regex( 's/0/o/g', rec1('200') ) ],  \[ qw/2ooa 2oob 2ooc 2ood 2ooa*2 2ood*2/ ]);
        is_deeply( \[ grep { /\*/ } regex( 's/0/o/g', rec1('200') ) ], \[ qw/2ooa*2 2ood*2/ ]);
        is_deeply( \[ rec('902') ], \[ '900' ] );
        cmp_ok( rec('902'), 'eq', rec('902','z') );

        set_lookup( $lookup1 );
        
        cmp_ok(
                join_with(" i ",
                        lookup( 
                                regex( 's/^/00/',
                                        rec2('902','z')
                                )
                        ) 
                ),
        'eq', 'lookup 1 i lookup 2');

        set_lookup( $lookup2 );

        is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ] );

        ok(! lookup('non-existent') );

        set_rec( $rec2 );

        test_s(qq{
                tag('Title',
                        rec('200','a')
                );
        });
        test_s(qq{
                tag('Who',
                        join_with(" ",
                                rec('702','a'),
                                rec('702','b')
                        )
                );
        });

        test_s(qq{
                display('Publisher',
                        rec('210','c')
                )
        });
        
        test_s(qq{
                search('Year',
                        regex( 's/[^\\d]+//',
                                rec('210','d')
                        )
                )
        });

        ok(my $ds = get_ds(), "get_ds");
        diag "ds = ", Dumper($ds) if ($debug);

        clean_ds();

        my $n = read_file( "$abs_path/data/normalize.pl" );
        $n .= "\n1;\n";
        #diag "normalize code:\n$n\n";
        test_s( $n );

        ok($ds = get_ds(), "get_ds");
        diag "ds = ", Dumper($ds) if ($debug);
}

1	dpavlin	460	#!/usr/bin/perl -w
2
3			use strict;
4
5	dpavlin	464	use Test::More tests => 25;
6	dpavlin	460	use Test::Exception;
7			use Cwd qw/abs_path/;
8			use blib;
9			use File::Slurp;
10
11			use Data::Dumper;
12	dpavlin	464	my $debug = 0;
13	dpavlin	460
14			BEGIN {
15			use_ok( 'WebPAC::Normalize::Set' );
16			}
17
18			ok(my $abs_path = abs_path($0), "abs_path");
19	dpavlin	468	$abs_path =~ s#/[^/]*$#/#;
20	dpavlin	464	diag "abs_path: $abs_path" if ($debug);
21	dpavlin	460
22			#throws_ok { new WebPAC::Normalize::XML( lookup_regex => 'foo' ) } qr/pair/, "lookup_regex without lookup";
23
24	dpavlin	464	my $rec1 = {
25			'200' => [{
26			'a' => '200a',
27			'b' => '200b',
28			},{
29			'c' => '200c',
30			'd' => '200d',
31			},{
32			'a' => '200a*2',
33			'd' => '200d*2',
34			}],
35			'201' => [{
36			'x' => '201x',
37			'y' => '201y',
38			}],
39			'900' => [
40			'900-no_subfield'
41			],
42			'901' => [{
43			'a' => '900a',
44			}],
45			'902' => [{
46			'z' => '900',
47			}],
48			};
49
50			my $rec2 = {
51	dpavlin	460	'675' => [ {
52			'a' => '159.9'
53			} ],
54			'210' => [ {
55			'c' => 'New York University press',
56			'a' => 'New York',
57			'd' => 'cop. 1988'
58			} ],
59			'700' => [ {
60			'a' => 'Haynal',
61			'b' => 'André'
62			} ],
63			'801' => [ 'FFZG' ],
64			'991' => [ '8302' ],
65			'000' => [ 1 ],
66			'702' => [ {
67			'a' => 'Holder',
68			'b' => 'Elizabeth'
69			} ],
70			'215' => [ {
71			'c' => 'ilustr',
72			'a' => 'xix, 202 str',
73			'd' => '23cm'
74			} ],
75			'990' => [
76			'2140',
77			'88',
78			'HAY'
79			],
80			'200' => [ {
81			'e' => 'from Freud and Ferenczi to Michael balint',
82			'a' => 'Controversies in psychoanalytic method',
83			'g' => 'translated by Elizabeth Holder on the basisi of a first draft by Archie Hooton ; with a preface by Daniel N. Stern',
84			'f' => 'by André E. Haynal'
85			} ],
86			'610' => [ 'povijest psihoanalize' ],
87			'994' => [ {
88			'c' => '',
89			'a' => 'PS',
90			'b' => 'MG'
91			} ],
92			'320' => [ 'Kazalo' ],
93			'101' => [ 'ENG' ],
94			'686' => [ '2140' ],
95			'300' => [ 'Prijevod djela: ' ],
96			};
97
98
99	dpavlin	464	my $lookup1 = {
100	dpavlin	460	'00900' => [
101	dpavlin	464	'lookup 1',
102			'lookup 2',
103	dpavlin	460	],
104			};
105
106	dpavlin	464	my $lookup2 = {
107			'00900' => 'lookup',
108			};
109	dpavlin	460
110	dpavlin	464
111	dpavlin	460	sub test {
112			print Dumper( @_ ), ("-" x 78), "\n";
113			ok( defined(@_) );
114			}
115
116			sub test_s {
117			my $t = shift \|\| die;
118	dpavlin	461	$t =~ s/[\n\r\s]+/ /gs;
119	dpavlin	460	ok(my $v = eval "$t", "eval: $t");
120	dpavlin	464	ok(! $@, $@ ? "error: $@" : "no error");
121	dpavlin	460	}
122
123			{
124			no strict 'subs';
125			use WebPAC::Normalize::Set;
126
127	dpavlin	464	set_rec( $rec1 );
128	dpavlin	460
129	dpavlin	464	cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2' );
130			cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b' );
131			cmp_ok( join(" * ", sort(rec1('200'), rec1('201') )), 'eq', '200a * 200a2 200b * 200c * 200d * 200d2 201x * 201y' );
132			is_deeply( \[ rec1('200') ], \[ qw/200a 200b 200c 200d 200a2 200d2/ ] );
133			is_deeply( \[ regex( 's/0/o/g', rec1('200') ) ], \[ qw/2ooa 2oob 2ooc 2ood 2ooa2 2ood2/ ]);
134			is_deeply( \[ grep { /\/ } regex( 's/0/o/g', rec1('200') ) ], \[ qw/2ooa2 2ood*2/ ]);
135			is_deeply( \[ rec('902') ], \[ '900' ] );
136			cmp_ok( rec('902'), 'eq', rec('902','z') );
137
138			set_lookup( $lookup1 );
139
140			cmp_ok(
141	dpavlin	460	join_with(" i ",
142			lookup(
143			regex( 's/^/00/',
144	dpavlin	464	rec2('902','z')
145	dpavlin	460	)
146			)
147	dpavlin	464	),
148			'eq', 'lookup 1 i lookup 2');
149	dpavlin	460
150	dpavlin	464	set_lookup( $lookup2 );
151
152			is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ] );
153
154			ok(! lookup('non-existent') );
155
156			set_rec( $rec2 );
157
158	dpavlin	460	test_s(qq{
159			tag('Title',
160			rec('200','a')
161			);
162			});
163			test_s(qq{
164			tag('Who',
165			join_with(" ",
166			rec('702','a'),
167			rec('702','b')
168			)
169			);
170			});
171
172			test_s(qq{
173			display('Publisher',
174			rec('210','c')
175			)
176			});
177
178			test_s(qq{
179			search('Year',
180			regex( 's/[^\\d]+//',
181			rec('210','d')
182			)
183			)
184			});
185
186			ok(my $ds = get_ds(), "get_ds");
187	dpavlin	464	diag "ds = ", Dumper($ds) if ($debug);
188	dpavlin	460
189	dpavlin	461	clean_ds();
190
191	dpavlin	468	my $n = read_file( "$abs_path/data/normalize.pl" );
192	dpavlin	461	$n .= "\n1;\n";
193	dpavlin	460	#diag "normalize code:\n$n\n";
194	dpavlin	461	test_s( $n );
195
196			ok($ds = get_ds(), "get_ds");
197	dpavlin	464	diag "ds = ", Dumper($ds) if ($debug);
198	dpavlin	460	}
199