2 |
|
|
3 |
use strict; |
use strict; |
4 |
|
|
5 |
use Test::More tests => 67; |
use Test::More tests => 81; |
6 |
use Test::Exception; |
use Test::Exception; |
7 |
use Cwd qw/abs_path/; |
use Cwd qw/abs_path/; |
8 |
use blib; |
use blib; |
9 |
use File::Slurp; |
use File::Slurp; |
10 |
|
|
11 |
use Data::Dumper; |
use Data::Dump qw/dump/; |
12 |
my $debug = shift @ARGV; |
my $debug = shift @ARGV; |
13 |
|
|
14 |
BEGIN { |
BEGIN { |
109 |
|
|
110 |
|
|
111 |
sub test { |
sub test { |
112 |
print Dumper( @_ ), ("-" x 78), "\n"; |
print dump( @_ ), ("-" x 78), "\n"; |
113 |
ok( defined(@_) ); |
ok( defined(@_) ); |
114 |
} |
} |
115 |
|
|
144 |
no strict 'subs'; |
no strict 'subs'; |
145 |
use WebPAC::Normalize; |
use WebPAC::Normalize; |
146 |
|
|
147 |
ok(! set_lookup( undef ), "set_lookup(undef)"); |
ok(! _set_lookup( undef ), "set_lookup(undef)"); |
148 |
|
|
149 |
set_rec( $rec1 ); |
_set_rec( $rec1 ); |
150 |
|
|
151 |
cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' ); |
cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' ); |
152 |
cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b', 'join rec2 rec2' ); |
cmp_ok( join(",", rec2('200','a'), rec2('200','b') ), 'eq', '200a,200a*2,200b', 'join rec2 rec2' ); |
165 |
cmp_ok( join('', surround('->', '<-', 'a','b','c') ), 'eq', '->a<-->b<-->c<-', 'surround'); |
cmp_ok( join('', surround('->', '<-', 'a','b','c') ), 'eq', '->a<-->b<-->c<-', 'surround'); |
166 |
|
|
167 |
|
|
168 |
set_lookup( $lookup1 ); |
_set_lookup( $lookup1 ); |
169 |
|
|
170 |
cmp_ok( |
cmp_ok( |
171 |
join_with(" i ", |
join_with(" i ", |
219 |
|
|
220 |
# test lookups |
# test lookups |
221 |
|
|
222 |
set_lookup( $lookup2 ); |
_set_lookup( $lookup2 ); |
223 |
|
|
224 |
is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' ); |
is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' ); |
225 |
|
|
226 |
ok(! lookup('non-existent'), 'lookup non-existant' ); |
ok(! lookup('non-existent'), 'lookup non-existant' ); |
227 |
|
|
228 |
set_rec( $rec2 ); |
_set_rec( $rec2 ); |
229 |
|
|
230 |
test_s(qq{ |
test_s(qq{ |
231 |
tag('Title', |
tag('Title', |
255 |
) |
) |
256 |
}); |
}); |
257 |
|
|
258 |
ok(my $ds = get_ds(), "get_ds"); |
ok(my $ds = _get_ds(), "get_ds"); |
259 |
diag "ds = ", Dumper($ds) if ($debug); |
diag "ds = ", dump($ds) if ($debug); |
260 |
|
|
261 |
|
|
262 |
sub test_check_ds { |
sub test_check_ds { |
263 |
|
|
264 |
my $t = shift; |
my $t = shift; |
265 |
|
|
266 |
ok($ds = get_ds(), 'get_ds'); |
ok($ds = _get_ds(), 'get_ds'); |
267 |
diag Dumper( $ds ) if ($debug); |
diag dump( $ds ) if ($debug); |
268 |
|
|
269 |
ok( $ds && $ds->{something}, 'get_ds->something exists' ); |
ok( $ds && $ds->{something}, 'get_ds->something exists' ); |
270 |
ok( $ds && $ds->{something}->{$t}, 'get_ds->something->'.$t.' exists') if ($t); |
ok( $ds && $ds->{something}->{$t}, 'get_ds->something->'.$t.' exists') if ($t); |
273 |
return $ds; |
return $ds; |
274 |
} |
} |
275 |
|
|
276 |
clean_ds(); |
_clean_ds(); |
277 |
test_s(qq{ search('something', '42'); }); |
test_s(qq{ search('something', '42'); }); |
278 |
test_s(qq{ search('empty', ''); }); |
test_s(qq{ search('empty', ''); }); |
279 |
test_check_ds('search'); |
test_check_ds('search'); |
280 |
|
|
281 |
clean_ds(); |
_clean_ds(); |
282 |
test_s(qq{ display('something', '42'); }); |
test_s(qq{ display('something', '42'); }); |
283 |
test_s(qq{ display('empty', ''); }); |
test_s(qq{ display('empty', ''); }); |
284 |
test_check_ds('display'); |
test_check_ds('display'); |
285 |
|
|
286 |
clean_ds(); |
_clean_ds(); |
287 |
test_s(qq{ tag('something', '42'); }); |
test_s(qq{ tag('something', '42'); }); |
288 |
test_s(qq{ tag('empty', ''); }); |
test_s(qq{ tag('empty', ''); }); |
289 |
test_check_ds('search'); |
test_check_ds('search'); |
290 |
test_check_ds('display'); |
test_check_ds('display'); |
291 |
|
|
292 |
clean_ds(); |
_clean_ds(); |
293 |
my $n = read_file( "$abs_path/data/normalize.pl" ); |
my $n = read_file( "$abs_path/data/normalize.pl" ); |
294 |
$n .= "\n1;\n"; |
$n .= "\n1;\n"; |
295 |
#diag "normalize code:\n$n\n"; |
#diag "normalize code:\n$n\n"; |
296 |
test_s( $n ); |
test_s( $n ); |
297 |
|
|
298 |
ok($ds = get_ds(), "get_ds"); |
ok($ds = _get_ds(), "get_ds"); |
299 |
diag "ds = ", Dumper($ds) if ($debug); |
diag "ds = ", dump($ds) if ($debug); |
300 |
|
|
301 |
my $rec = { |
my $rec = { |
302 |
'200' => [{ |
'200' => [{ |
306 |
}; |
}; |
307 |
my $rules = qq{ search('mixed', rec('200') ) }; |
my $rules = qq{ search('mixed', rec('200') ) }; |
308 |
|
|
309 |
clean_ds(); |
_clean_ds(); |
310 |
set_rec( $rec ); |
_set_rec( $rec ); |
311 |
test_s( $rules ); |
test_s( $rules ); |
312 |
ok($ds = get_ds(), "get_ds"); |
ok($ds = _get_ds(), "get_ds"); |
313 |
is_deeply( $ds, { |
is_deeply( $ds, { |
314 |
'mixed' => { |
'mixed' => { |
315 |
'search' => [ '200a', '200b' ], |
'search' => [ '200a', '200b' ], |
324 |
is_deeply( $ds, $ds2, 'data_structure(s) same'); |
is_deeply( $ds, $ds2, 'data_structure(s) same'); |
325 |
|
|
326 |
# wird and non-valid structure which is supported anyway |
# wird and non-valid structure which is supported anyway |
327 |
clean_ds(); |
_clean_ds(); |
328 |
set_rec({ |
_set_rec({ |
329 |
'200' => [{ |
'200' => [{ |
330 |
'a' => '200a', |
'a' => '200a', |
331 |
}, |
}, |
333 |
] |
] |
334 |
}); |
}); |
335 |
test_s(qq{ search('mixed', rec('200') ) }); |
test_s(qq{ search('mixed', rec('200') ) }); |
336 |
ok($ds = get_ds(), "get_ds"); |
ok($ds = _get_ds(), "get_ds"); |
337 |
is_deeply( $ds, { |
is_deeply( $ds, { |
338 |
'mixed' => { |
'mixed' => { |
339 |
'search' => [ '200a', '200-solo' ], |
'search' => [ '200a', '200-solo' ], |
341 |
} |
} |
342 |
}, 'correct get_ds'); |
}, 'correct get_ds'); |
343 |
|
|
344 |
|
# MARC |
345 |
|
test_s(qq{ marc_indicators('900',1,2) }); |
346 |
|
test_s(qq{ marc('900','a', rec('200') ) }); |
347 |
|
my @marc; |
348 |
|
ok(@marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields"); |
349 |
|
diag dump( \@marc ) if ($debug); |
350 |
|
|
351 |
|
is_deeply( \@marc, [ |
352 |
|
[ '900', 1, 2, 'a', '200a' ], |
353 |
|
[ '900', 1, 2, 'a', '200-solo' ] |
354 |
|
], 'correct marc with indicators'); |
355 |
|
|
356 |
|
test_s(qq{ marc_indicators('900',' ',9) }); |
357 |
|
test_s(qq{ marc_repeatable_subfield('900','a', rec('200') ) }); |
358 |
|
|
359 |
|
ok(@marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields"); |
360 |
|
diag dump( \@marc ) if ($debug); |
361 |
|
|
362 |
|
is_deeply( \@marc, [ |
363 |
|
[ '900', 1, 2, 'a', '200a', 'a', '200-solo' ], |
364 |
|
[ '900', ' ', 9, 'a', '200a', 'a', '200-solo' ] |
365 |
|
], 'correct marc with repetable subfield'); |
366 |
|
|
367 |
|
_clean_ds(); |
368 |
|
_set_rec({ |
369 |
|
'200' => [{ |
370 |
|
'a' => '200a-1', |
371 |
|
'b' => '200b-1', |
372 |
|
'c' => '200c-1', |
373 |
|
}, { |
374 |
|
'a' => '200a-2', |
375 |
|
'b' => '200b-2', |
376 |
|
'c' => '200c-2', |
377 |
|
}, { |
378 |
|
'a' => '200a-3', |
379 |
|
'c' => '200c-3', |
380 |
|
}] |
381 |
|
}); |
382 |
|
test_s(qq{ marc_indicators('900',1 ,0) }); |
383 |
|
test_s(qq{ marc_repeatable_subfield('900','a', rec('200','a') ) }); |
384 |
|
test_s(qq{ marc('900','b', rec('200','b') ) }); |
385 |
|
test_s(qq{ marc('900','c', rec('200','c') ) }); |
386 |
|
|
387 |
|
ok(@marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields"); |
388 |
|
diag dump( \@marc ) if ($debug); |
389 |
|
|
390 |
|
is_deeply( \@marc, [ |
391 |
|
[ '900', 1, 0, 'a', '200a-1', 'a', '200a-2', 'a', '200a-3', 'b', '200b-1', 'c', '200c-1' ], |
392 |
|
[ '900', 1, 0, 'b', '200b-2', 'c', '200c-2' ], |
393 |
|
[ '900', 1, 0, 'c', '200c-3' ], |
394 |
|
], 'correct marc with repetable subfield'); |
395 |
} |
} |
396 |
|
|