1 |
#!/usr/bin/perl -w |
#!/usr/bin/perl -w |
2 |
|
|
3 |
use Test::More tests => 10; |
use Test::More tests => 76; |
4 |
use Test::Exception; |
use Test::Exception; |
5 |
use Cwd qw/abs_path/; |
use Cwd qw/abs_path/; |
6 |
use blib; |
use blib; |
7 |
use strict; |
use strict; |
8 |
|
use Data::Dumper; |
9 |
|
|
10 |
BEGIN { |
BEGIN { |
11 |
use_ok( 'WebPAC::Normalize::XML' ); |
use_ok( 'WebPAC::Normalize::XML' ); |
18 |
throws_ok { new WebPAC::Normalize::XML( lookup_regex => 'foo' ) } qr/pair/, "lookup_regex without lookup"; |
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"; |
throws_ok { new WebPAC::Normalize::XML( lookup => 'bar' ) } qr/pair/, "lookup without lookup_regex"; |
20 |
|
|
21 |
ok(my $n = new WebPAC::Normalize::XML( debug => 0 ), "new"); |
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 |
|
|
32 |
throws_ok { $n->open() } qr/tag/, "open without tag"; |
throws_ok { $n->open() } qr/tag/, "open without tag"; |
33 |
throws_ok { $n->open( tag => 'isis' ) } qr/xml_file/, "open without xml_file"; |
throws_ok { $n->open( tag => 'isis' ) } qr/xml_file/, "open without xml_file"; |
34 |
throws_ok { $n->open( tag => 'isis', xml_file => 'foo' ) } qr/file.*doesn't exist/, "open with invalid xml_file"; |
throws_ok { $n->open( tag => 'isis', xml_file => '/foo/bar/baz' ) } qr/file.*doesn't exist/, "open with invalid xml_file"; |
35 |
ok( $n->open( |
ok( $n->open( |
36 |
tag => 'isis', |
tag => 'isis', |
37 |
xml_file => "$abs_path../conf/normalize/isis.xml", |
xml_file => "$abs_path/data/normalize.xml", |
38 |
), "open"); |
), "open"); |
39 |
|
|
40 |
my $rec = { |
my $rec = { |
41 |
'000' => [ '001' ], |
'675' => [ |
42 |
'800' => [ 'foo' ], |
{ |
43 |
'900' => [ 'bar' ], |
'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 |
}; |
}; |
117 |
|
|
118 |
ok(my @ds = $n->data_structure( $rec ), "data_structure"); |
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 |
|
ok(my $ds = $n->data_structure( $rec ), "data_structure"); |
142 |
|
|
143 |
|
#diag Dumper($rec, $ds); |
144 |
|
|
145 |
|
# fake load of our test normalisation data |
146 |
|
$n->{tag} = 'isis'; |
147 |
|
|
148 |
|
#diag Dumper($n->{import_xml}->{indexer}); |
149 |
|
|
150 |
|
|
151 |
|
$rec = { |
152 |
|
'900' => [ |
153 |
|
{ |
154 |
|
'a' => '1', |
155 |
|
'b' => '2', |
156 |
|
'c' => '3', |
157 |
|
} |
158 |
|
], |
159 |
|
}; |
160 |
|
|
161 |
|
my $import = { |
162 |
|
'Tag' => { 'isis' => [ |
163 |
|
{ content => 'v900^a + v900^b = v900^c' }, |
164 |
|
] }, |
165 |
|
}; |
166 |
|
|
167 |
|
sub parse_test($$$) { |
168 |
|
my ($import,$rec,$r) = @_; |
169 |
|
$n->{import_xml}->{indexer} = $import; |
170 |
|
# erase internal cache (yak!) |
171 |
|
delete($n->{tags_by_order}); |
172 |
|
push @{$rec->{'000'}}, 42; |
173 |
|
diag "test normalisation of: ",Dumper($n->{import_xml}->{indexer}, $rec); |
174 |
|
ok(my $ds = $n->data_structure( $rec ), "data_structure"); |
175 |
|
diag Dumper($ds); |
176 |
|
cmp_ok($ds->{Tag}->{display}->[0], 'eq', $r, "parse $r"); |
177 |
|
} |
178 |
|
|
179 |
|
parse_test($import, $rec, '1 + 2 = 3'); |