trunk/t/3-normalize-xml.t

#!/usr/bin/perl -w

use Test::More tests => 76;
use Test::Exception;
use Cwd qw/abs_path/;
use blib;
use strict;
use Data::Dumper;

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

ok(my $abs_path = abs_path($0), "abs_path");
$abs_path =~ s#/[^/]*$#/#;
diag "abs_path: $abs_path";

throws_ok { new WebPAC::Normalize::XML( lookup_regex => 'foo' ) } qr/pair/, "lookup_regex without lookup";
throws_ok { new WebPAC::Normalize::XML( lookup => 'bar' ) } qr/pair/, "lookup without lookup_regex";

ok(my $n = new WebPAC::Normalize::XML(
        debug => 1,
        filter => {
                regex => sub {
                        my ($val, $regex) = @_;
                        eval "\$val =~ $regex";
                        return $val;
                },
        },
), "new");

throws_ok { $n->open() } qr/tag/, "open without tag";
throws_ok { $n->open( tag => 'isis' ) } qr/xml_file/, "open without xml_file";
throws_ok { $n->open( tag => 'isis', xml_file => '/foo/bar/baz' ) } qr/file.*doesn't exist/, "open with invalid xml_file";
ok( $n->open(
        tag => 'isis',
        xml_file => "$abs_path/data/normalize.xml",
), "open");

my $rec = {
 '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: '
          ]
};

foreach my $fld (keys %$rec) {
        my $r = 0;
        foreach my $item ($rec->{$fld}) {
                if (ref($item) eq 'HASH') {
                        foreach my $sf (keys %$item) {
                                my $found = 0;
                                ok($n->get_data(\$rec, $fld, $sf, $r, \$found), "v${fld}^${sf}");
                                ok($found, "found");
                        }
                        my $found = 0;
                        ok(! $n->get_data(\$rec, $fld, 'x', $r, \$found), "no v${fld}^x");
                        ok(! $found, "not found");
                } else {
                        my $found = 0;
                        ok($n->get_data(\$rec, $fld, '', $r, \$found), "v${fld}");
                        ok($found, "found");
                }
        }
        my $found = 0;
        ok(! $n->get_data(\$rec, '999', '', $r, \$found), "no v${fld}");
        ok(! $found, "not found");
}

ok(my $ds = $n->data_structure( $rec ), "data_structure");

#diag Dumper($rec, $ds);

# fake load of our test normalisation data
$n->{tag} = 'isis';

#diag Dumper($n->{import_xml}->{indexer});


$rec = {
        '900' => [ {
                'a' => '1',
                'b' => '2',
                'c' => '3',
                'txt' => 'yap',
        } ],
};

my $import = {
        'Tag' => { 'isis' => [
                        { content => 'v900^a + v900^b = v900^c [txt]' },
        ] },
};

sub parse_test($$$) {
        my ($import,$rec,$r) = @_;
        $n->{import_xml}->{indexer} = $import;
        # erase internal cache (yak!)
        delete($n->{tags_by_order});
        push @{$rec->{'000'}}, 42 unless ($rec->{'000'});
        diag "test normalisation of: ",Dumper($n->{import_xml}->{indexer}, $rec);
        ok(my $ds = $n->data_structure( $rec ), "data_structure");
        diag Dumper($ds);
        cmp_ok($ds->{Tag}->{display}->[0], 'eq', $r, "parse $r");
}

parse_test($import, $rec, '1 + 2 = 3 [yap]');

delete($rec->{'900'}->[0]->{'b'});
parse_test($import, $rec, '1 = 3 [yap]');

$rec->{'900'}->[0]->{'b'} = 5;
$rec->{'900'}->[0]->{'c'} = 6;
parse_test($import, $rec, '1 + 5 = 6 [yap]');

delete($rec->{'900'}->[0]->{'c'});
parse_test($import, $rec, '1 + 5');

$rec->{'900'}->[0]->{'txt'} = 'nope!';
delete($rec->{'900'}->[0]->{'a'});
parse_test($import, $rec, '5 [nope!]');

1	dpavlin	12	#!/usr/bin/perl -w
2
3	dpavlin	314	use Test::More tests => 76;
4	dpavlin	12	use Test::Exception;
5			use Cwd qw/abs_path/;
6			use blib;
7			use strict;
8	dpavlin	62	use Data::Dumper;
9	dpavlin	12
10			BEGIN {
11			use_ok( 'WebPAC::Normalize::XML' );
12			}
13
14			ok(my $abs_path = abs_path($0), "abs_path");
15			$abs_path =~ s#/[^/]*$#/#;
16			diag "abs_path: $abs_path";
17
18	dpavlin	31	throws_ok { new WebPAC::Normalize::XML( lookup_regex => 'foo' ) } qr/pair/, "lookup_regex without lookup";
19			throws_ok { new WebPAC::Normalize::XML( lookup => 'bar' ) } qr/pair/, "lookup without lookup_regex";
20
21	dpavlin	260	ok(my $n = new WebPAC::Normalize::XML(
22			debug => 1,
23			filter => {
24			regex => sub {
25			my ($val, $regex) = @_;
26			eval "\$val =~ $regex";
27			return $val;
28			},
29			},
30			), "new");
31	dpavlin	13
32			throws_ok { $n->open() } qr/tag/, "open without tag";
33			throws_ok { $n->open( tag => 'isis' ) } qr/xml_file/, "open without xml_file";
34	dpavlin	62	throws_ok { $n->open( tag => 'isis', xml_file => '/foo/bar/baz' ) } qr/file.*doesn't exist/, "open with invalid xml_file";
35	dpavlin	13	ok( $n->open(
36	dpavlin	12	tag => 'isis',
37	dpavlin	64	xml_file => "$abs_path/data/normalize.xml",
38	dpavlin	13	), "open");
39	dpavlin	12
40	dpavlin	13	my $rec = {
41	dpavlin	64	'675' => [
42			{
43			'a' => '159.9'
44			}
45			],
46			'210' => [
47			{
48			'c' => 'New York University press',
49			'a' => 'New York',
50			'd' => 'cop. 1988'
51			}
52			],
53			'700' => [
54			{
55			'a' => 'Haynal',
56			'b' => 'André'
57			}
58			],
59			'801' => [
60			'FFZG'
61			],
62			'991' => [
63			'8302'
64			],
65			'000' => [
66			1
67			],
68			'702' => [
69			{
70			'a' => 'Holder',
71			'b' => 'Elizabeth'
72			}
73			],
74			'215' => [
75			{
76			'c' => 'ilustr',
77			'a' => 'xix, 202 str',
78			'd' => '23cm'
79			}
80			],
81			'990' => [
82			'2140',
83			'88',
84			'HAY'
85			],
86			'200' => [
87			{
88			'e' => 'from Freud and Ferenczi to Michael balint',
89			'a' => 'Controversies in psychoanalytic method',
90			'g' => 'translated by Elizabeth Holder on the basisi of a first draft by Archie Hooton ; with a preface by Daniel N. Stern',
91			'f' => 'by André E. Haynal'
92			}
93			],
94			'610' => [
95			'povijest psihoanalize'
96			],
97			'994' => [
98			{
99			'c' => '',
100			'a' => 'PS',
101			'b' => 'MG'
102			}
103			],
104			'320' => [
105			'Kazalo'
106			],
107			'101' => [
108			'ENG'
109			],
110			'686' => [
111			'2140'
112			],
113			'300' => [
114			'Prijevod djela: '
115			]
116	dpavlin	13	};
117	dpavlin	12
118	dpavlin	64	foreach my $fld (keys %$rec) {
119			my $r = 0;
120			foreach my $item ($rec->{$fld}) {
121			if (ref($item) eq 'HASH') {
122			foreach my $sf (keys %$item) {
123			my $found = 0;
124			ok($n->get_data(\$rec, $fld, $sf, $r, \$found), "v${fld}^${sf}");
125			ok($found, "found");
126			}
127			my $found = 0;
128			ok(! $n->get_data(\$rec, $fld, 'x', $r, \$found), "no v${fld}^x");
129			ok(! $found, "not found");
130			} else {
131			my $found = 0;
132			ok($n->get_data(\$rec, $fld, '', $r, \$found), "v${fld}");
133			ok($found, "found");
134			}
135			}
136			my $found = 0;
137			ok(! $n->get_data(\$rec, '999', '', $r, \$found), "no v${fld}");
138			ok(! $found, "not found");
139			}
140
141	dpavlin	70	ok(my $ds = $n->data_structure( $rec ), "data_structure");
142	dpavlin	13
143	dpavlin	260	#diag Dumper($rec, $ds);
144	dpavlin	70
145	dpavlin	314	# fake load of our test normalisation data
146			$n->{tag} = 'isis';
147
148			#diag Dumper($n->{import_xml}->{indexer});
149
150
151			$rec = {
152	dpavlin	315	'900' => [ {
153			'a' => '1',
154			'b' => '2',
155			'c' => '3',
156			'txt' => 'yap',
157			} ],
158	dpavlin	314	};
159
160			my $import = {
161			'Tag' => { 'isis' => [
162	dpavlin	315	{ content => 'v900^a + v900^b = v900^c [txt]' },
163	dpavlin	314	] },
164			};
165
166			sub parse_test($$$) {
167			my ($import,$rec,$r) = @_;
168			$n->{import_xml}->{indexer} = $import;
169			# erase internal cache (yak!)
170			delete($n->{tags_by_order});
171	dpavlin	315	push @{$rec->{'000'}}, 42 unless ($rec->{'000'});
172	dpavlin	314	diag "test normalisation of: ",Dumper($n->{import_xml}->{indexer}, $rec);
173			ok(my $ds = $n->data_structure( $rec ), "data_structure");
174			diag Dumper($ds);
175			cmp_ok($ds->{Tag}->{display}->[0], 'eq', $r, "parse $r");
176			}
177
178	dpavlin	315	parse_test($import, $rec, '1 + 2 = 3 [yap]');
179
180			delete($rec->{'900'}->[0]->{'b'});
181			parse_test($import, $rec, '1 = 3 [yap]');
182
183			$rec->{'900'}->[0]->{'b'} = 5;
184			$rec->{'900'}->[0]->{'c'} = 6;
185			parse_test($import, $rec, '1 + 5 = 6 [yap]');
186
187			delete($rec->{'900'}->[0]->{'c'});
188			parse_test($import, $rec, '1 + 5');
189
190			$rec->{'900'}->[0]->{'txt'} = 'nope!';
191			delete($rec->{'900'}->[0]->{'a'});
192			parse_test($import, $rec, '5 [nope!]');
193