1 |
#!/usr/bin/perl -w |
#!/usr/bin/perl -w |
2 |
|
|
3 |
use Test::More tests => 74; |
use Test::More tests => 132; |
4 |
use Test::Exception; |
use Test::Exception; |
5 |
use Cwd qw/abs_path/; |
use Cwd qw/abs_path/; |
6 |
use blib; |
use blib; |
13 |
|
|
14 |
ok(my $abs_path = abs_path($0), "abs_path"); |
ok(my $abs_path = abs_path($0), "abs_path"); |
15 |
$abs_path =~ s#/[^/]*$#/#; |
$abs_path =~ s#/[^/]*$#/#; |
16 |
diag "abs_path: $abs_path"; |
#diag "abs_path: $abs_path"; |
17 |
|
|
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 => 0, |
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"; |
140 |
|
|
141 |
ok(my $ds = $n->data_structure( $rec ), "data_structure"); |
ok(my $ds = $n->data_structure( $rec ), "data_structure"); |
142 |
|
|
143 |
diag Dumper($rec, $ds); |
#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 |
|
'a' => '1', |
154 |
|
'b' => '2', |
155 |
|
'c' => '3', |
156 |
|
'x' => 'yap', |
157 |
|
} ], |
158 |
|
}; |
159 |
|
|
160 |
|
my $import = { |
161 |
|
'Tag' => { 'isis' => [ |
162 |
|
{ content => 'v900^a + v900^b = v900^c [v900^x]' }, |
163 |
|
] }, |
164 |
|
}; |
165 |
|
|
166 |
|
sub parse_test($$$$$) { |
167 |
|
my ($import,$tag,$rec,$i,$r) = @_; |
168 |
|
$n->{import_xml}->{indexer} = $import; |
169 |
|
# erase internal cache (yak!) |
170 |
|
delete($n->{tags_by_order}); |
171 |
|
push @{$rec->{'000'}}, 42 unless ($rec->{'000'}); |
172 |
|
#diag "test normalisation of: ",Dumper($n->{import_xml}->{indexer}, $rec); |
173 |
|
ok(my $ds = $n->data_structure( $rec ), "data_structure"); |
174 |
|
diag Dumper($ds) if ($i == 0); |
175 |
|
cmp_ok($ds->{$tag}->{display}->[$i], 'eq', $r, "parse $tag/$i - $r"); |
176 |
|
} |
177 |
|
|
178 |
|
parse_test($import, 'Tag', $rec, 0, '1 + 2 = 3 [yap]'); |
179 |
|
|
180 |
|
delete($rec->{'900'}->[0]->{'b'}); |
181 |
|
parse_test($import, 'Tag', $rec, 0, '1 = 3 [yap]'); |
182 |
|
|
183 |
|
$rec->{'900'}->[0]->{'b'} = 5; |
184 |
|
$rec->{'900'}->[0]->{'c'} = 6; |
185 |
|
parse_test($import, 'Tag', $rec, 0, '1 + 5 = 6 [yap]'); |
186 |
|
|
187 |
|
delete($rec->{'900'}->[0]->{'c'}); |
188 |
|
$rec->{'900'}->[0]->{'x'} = 'hmmm'; |
189 |
|
parse_test($import, 'Tag', $rec, 0, '1 + 5 [hmmm]'); |
190 |
|
|
191 |
|
$rec->{'900'}->[0]->{'x'} = 'nope!'; |
192 |
|
delete($rec->{'900'}->[0]->{'a'}); |
193 |
|
parse_test($import, 'Tag', $rec, 0, '5 [nope!]'); |
194 |
|
|
195 |
|
$rec = { |
196 |
|
'900' => [ { |
197 |
|
'b' => 'b1', |
198 |
|
'x' => 'b1', |
199 |
|
},{ |
200 |
|
'a' => 'a1', |
201 |
|
'b' => 'b2', |
202 |
|
'x' => 'a1_b2', |
203 |
|
},{ |
204 |
|
'b' => 'b3', |
205 |
|
'c' => 'c1', |
206 |
|
'x' => 'b3_c1', |
207 |
|
},{ |
208 |
|
'a' => 'a2', |
209 |
|
'b' => 'b4', |
210 |
|
'c' => 'c2', |
211 |
|
'x' => 'a2_b4_c2', |
212 |
|
} ], |
213 |
|
}; |
214 |
|
|
215 |
|
my $import = { |
216 |
|
'Tag' => { 'isis' => [ |
217 |
|
{ content => '0 v900^a 1 v900^b 2 v900^c 3 v900^x 4' }, |
218 |
|
] }, |
219 |
|
}; |
220 |
|
|
221 |
|
parse_test($import, 'Tag', $rec, 0, '0 b1 3 b1 4'); |
222 |
|
parse_test($import, 'Tag', $rec, 1, '0 a1 1 b2 3 a1_b2 4'); |
223 |
|
parse_test($import, 'Tag', $rec, 2, '0 b3 2 c1 3 b3_c1 4'); |
224 |
|
parse_test($import, 'Tag', $rec, 3, '0 a2 1 b4 2 c2 3 a2_b4_c2 4'); |
225 |
|
|
226 |
|
sub parse_test_arr($$$$) { |
227 |
|
my ($import, $tag, $rec, $arr) = @_; |
228 |
|
my $i = 0; |
229 |
|
foreach my $res (@{$arr}) { |
230 |
|
parse_test($import, $tag, $rec, $i, $res); |
231 |
|
$i++; |
232 |
|
} |
233 |
|
} |
234 |
|
|
235 |
|
my $import = { |
236 |
|
'Tag_a' => { 'isis' => [ |
237 |
|
{ content => 'v900^a' }, |
238 |
|
] }, |
239 |
|
'Tag_b' => { 'isis' => [ |
240 |
|
{ content => 'v900^b' }, |
241 |
|
] }, |
242 |
|
'Tag_c' => { 'isis' => [ |
243 |
|
{ content => 'v900^c' }, |
244 |
|
] }, |
245 |
|
'Tag_x' => { 'isis' => [ |
246 |
|
{ content => 'v900^x' }, |
247 |
|
] }, |
248 |
|
'Tag_s1' => { 'isis' => [ |
249 |
|
{ content => 's900^b = s900^x' }, |
250 |
|
] }, |
251 |
|
'Tag_s2' => { 'isis' => [ |
252 |
|
{ content => 's900^a s900^b s900^c s900^x' }, |
253 |
|
] }, |
254 |
|
}; |
255 |
|
|
256 |
|
parse_test_arr($import, 'Tag_a', $rec, [ '','a1','','a2' ] ); |
257 |
|
parse_test_arr($import, 'Tag_b', $rec, [ 'b1','b2','b3','b4' ] ); |
258 |
|
parse_test_arr($import, 'Tag_c', $rec, [ '','','c1','c2' ] ); |
259 |
|
parse_test_arr($import, 'Tag_x', $rec, [ 'b1','a1_b2','b3_c1','a2_b4_c2' ] ); |
260 |
|
parse_test_arr($import, 'Tag_s1', $rec, [ 'b1 = b1', 'b1 = b1', 'b1 = b1', 'b1 = b1' ] ); |
261 |
|
|