/[webpac2]/trunk/t/3-normalize.t
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/t/3-normalize.t

Parent Directory Parent Directory | Revision Log Revision Log


Revision 540 - (show annotations)
Thu Jun 29 15:29:41 2006 UTC (17 years, 9 months ago) by dpavlin
File MIME type: application/x-troff
File size: 7456 byte(s)
 r726@llin:  dpavlin | 2006-06-29 17:31:13 +0200
 add marc21 to normalize and create MARC file from those data [2.22]

1 #!/usr/bin/perl -w
2
3 use strict;
4
5 use Test::More tests => 69;
6 use Test::Exception;
7 use Cwd qw/abs_path/;
8 use blib;
9 use File::Slurp;
10
11 use Data::Dumper;
12 my $debug = shift @ARGV;
13
14 BEGIN {
15 use_ok( 'WebPAC::Normalize' );
16 }
17
18 ok(my $abs_path = abs_path($0), "abs_path");
19 $abs_path =~ s#/[^/]*$#/#;
20 diag "abs_path: $abs_path" if ($debug);
21
22 #throws_ok { new WebPAC::Normalize::XML( lookup_regex => 'foo' ) } qr/pair/, "lookup_regex without lookup";
23
24 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 '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 my $lookup1 = {
100 '00900' => [
101 'lookup 1',
102 'lookup 2',
103 ],
104 };
105
106 my $lookup2 = {
107 '00900' => 'lookup',
108 };
109
110
111 sub test {
112 print Dumper( @_ ), ("-" x 78), "\n";
113 ok( defined(@_) );
114 }
115
116 # how much of string evaled to display?
117 my $max_eval_output = 170;
118
119 sub dump_error {
120 my ($msg,$code) = @_;
121
122 my @l = split(/[\n\r]/, $code);
123 my $out = "$msg\n";
124
125 foreach my $i ( 0 .. $#l ) {
126 $out .= sprintf("%2d: %s\n", $i, $l[$i]);
127 }
128
129 return $out;
130 }
131
132 sub test_s {
133 my $t = shift || die;
134
135 my $eval_t = $t;
136 $eval_t =~ s/[\n\r\s]+/ /gs;
137 $eval_t = substr($eval_t,0,$max_eval_output) . '...' if (length($eval_t) > $max_eval_output);
138
139 eval "$t";
140 ok(! $@, $@ ? dump_error($@, $t) : "eval: $eval_t");
141 }
142
143 {
144 no strict 'subs';
145 use WebPAC::Normalize;
146
147 ok(! _set_lookup( undef ), "set_lookup(undef)");
148
149 _set_rec( $rec1 );
150
151 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' );
153 cmp_ok( join(" * ", sort(rec1('200'), rec1('201') )), 'eq', '200a * 200a*2 * 200b * 200c * 200d * 200d*2 * 201x * 201y', 'join sort rec1 rec1' );
154 diag "is_deeply checks\n";
155 is_deeply( \[ rec1('200') ], \[ qw/200a 200b 200c 200d 200a*2 200d*2/ ] );
156 is_deeply( \[ regex( 's/0/o/g', rec1('200') ) ], \[ qw/2ooa 2oob 2ooc 2ood 2ooa*2 2ood*2/ ]);
157 is_deeply( \[ grep { /\*/ } regex( 's/0/o/g', rec1('200') ) ], \[ qw/2ooa*2 2ood*2/ ]);
158 is_deeply( \[ rec('902') ], \[ '900' ] );
159
160 cmp_ok( rec('902'), 'eq', rec('902','z'), 'rec sf' );
161
162 # simple list manipulatons
163 cmp_ok( join('', prefix('ab', 'cd') ), 'eq', 'abcd', 'prefix');
164 cmp_ok( join('', suffix('xy', 'cd') ), 'eq', 'cdxy', 'suffix');
165 cmp_ok( join('', surround('->', '<-', 'a','b','c') ), 'eq', '->a<-->b<-->c<-', 'surround');
166
167
168 _set_lookup( $lookup1 );
169
170 cmp_ok(
171 join_with(" i ",
172 lookup(
173 regex( 's/^/00/',
174 rec2('902','z')
175 )
176 )
177 ),
178 'eq', 'lookup 1 i lookup 2', 'join lookup regex rec2');
179
180 # check join_with operations
181
182 sub test_join_with_2 {
183 my ($a,$b,$e) = @_;
184
185 cmp_ok(
186 join_with(" <1> ",
187 rec('201',$a),
188 rec('201',$b),
189 ),
190 'eq', $e, "join_with $a <1> $b = $e");
191 }
192
193 test_join_with_2('_','_','');
194 test_join_with_2('x','_','201x');
195 test_join_with_2('_','x','201x');
196 test_join_with_2('x','y','201x <1> 201y');
197
198 sub test_join_with_3 {
199 my ($a,$b,$c,$e) = @_;
200
201 cmp_ok(
202 join_with(" <1> ", rec('201',$a),
203 join_with(" <2> ", rec('201',$b),
204 rec('201',$c),
205 )
206 ),
207 'eq', $e, "join_with $a <1> $b <2> $c = $e");
208 };
209
210 test_join_with_3('_','_','_','');
211 test_join_with_3('x','_','_','201x');
212 test_join_with_3('_','x','_','201x');
213 test_join_with_3('_','_','x','201x');
214 test_join_with_3('x','y','_','201x <1> 201y');
215 test_join_with_3('x','_','y','201x <1> 201y');
216 test_join_with_3('_','x','y','201x <2> 201y');
217 test_join_with_3('x','_','y','201x <1> 201y');
218 test_join_with_3('x','y','x','201x <1> 201y <2> 201x');
219
220 # test lookups
221
222 _set_lookup( $lookup2 );
223
224 is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' );
225
226 ok(! lookup('non-existent'), 'lookup non-existant' );
227
228 _set_rec( $rec2 );
229
230 test_s(qq{
231 tag('Title',
232 rec('200','a')
233 );
234 });
235 test_s(qq{
236 tag('Who',
237 join_with(" ",
238 rec('702','a'),
239 rec('702','b')
240 )
241 );
242 });
243
244 test_s(qq{
245 display('Publisher',
246 rec('210','c')
247 )
248 });
249
250 test_s(qq{
251 search('Year',
252 regex( 's/[^\\d]+//',
253 rec('210','d')
254 )
255 )
256 });
257
258 ok(my $ds = _get_ds(), "get_ds");
259 diag "ds = ", Dumper($ds) if ($debug);
260
261
262 sub test_check_ds {
263
264 my $t = shift;
265
266 ok($ds = _get_ds(), 'get_ds');
267 diag Dumper( $ds ) if ($debug);
268
269 ok( $ds && $ds->{something}, 'get_ds->something exists' );
270 ok( $ds && $ds->{something}->{$t}, 'get_ds->something->'.$t.' exists') if ($t);
271 ok( $ds && !$ds->{empty}, 'get_ds->empty doesn\'t' );
272
273 return $ds;
274 }
275
276 _clean_ds();
277 test_s(qq{ search('something', '42'); });
278 test_s(qq{ search('empty', ''); });
279 test_check_ds('search');
280
281 _clean_ds();
282 test_s(qq{ display('something', '42'); });
283 test_s(qq{ display('empty', ''); });
284 test_check_ds('display');
285
286 _clean_ds();
287 test_s(qq{ tag('something', '42'); });
288 test_s(qq{ tag('empty', ''); });
289 test_check_ds('search');
290 test_check_ds('display');
291
292 _clean_ds();
293 my $n = read_file( "$abs_path/data/normalize.pl" );
294 $n .= "\n1;\n";
295 #diag "normalize code:\n$n\n";
296 test_s( $n );
297
298 ok($ds = _get_ds(), "get_ds");
299 diag "ds = ", Dumper($ds) if ($debug);
300
301 my $rec = {
302 '200' => [{
303 'a' => '200a',
304 'b' => '200b',
305 }],
306 };
307 my $rules = qq{ search('mixed', rec('200') ) };
308
309 _clean_ds();
310 _set_rec( $rec );
311 test_s( $rules );
312 ok($ds = _get_ds(), "get_ds");
313 is_deeply( $ds, {
314 'mixed' => {
315 'search' => [ '200a', '200b' ],
316 'tag' => 'mixed'
317 }
318 }, 'correct get_ds');
319
320 ok(my $ds2 = WebPAC::Normalize::data_structure(
321 row => $rec,
322 rules => $rules,
323 ), 'data_structure');
324 is_deeply( $ds, $ds2, 'data_structure(s) same');
325
326 # wird and non-valid structure which is supported anyway
327 _clean_ds();
328 _set_rec({
329 '200' => [{
330 'a' => '200a',
331 },
332 '200-solo'
333 ]
334 });
335 test_s(qq{ search('mixed', rec('200') ) });
336 ok($ds = _get_ds(), "get_ds");
337 is_deeply( $ds, {
338 'mixed' => {
339 'search' => [ '200a', '200-solo' ],
340 'tag' => 'mixed'
341 }
342 }, 'correct get_ds');
343
344 # MARC
345 test_s(qq{ marc21('900','a', rec('200') ) });
346 my @marc;
347 ok(@marc = WebPAC::Normalize::_get_marc21_fields(), "_get_marc21_fields");
348 diag Dumper(\@marc);
349 }
350

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26