/[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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 536 by dpavlin, Mon Jun 26 16:39:51 2006 UTC revision 555 by dpavlin, Sat Jul 1 10:19:39 2006 UTC
# Line 2  Line 2 
2    
3  use strict;  use strict;
4    
5  use Test::More tests => 67;  use Test::More tests => 89;
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    use Getopt::Long;
 use Data::Dumper;  
 my $debug = shift @ARGV;  
11    
12  BEGIN {  BEGIN {
13          use_ok( 'WebPAC::Normalize' );          use_ok( 'WebPAC::Normalize' );
14  }  }
15    
16    use Data::Dump qw/dump/;
17    
18    my $debug = 0;
19    GetOptions(
20            "debug+", \$debug
21    );
22    
23    cmp_ok(_debug(1), '==', 1, '_debug level');
24    cmp_ok(_debug(0), '==', 0, '_debug level');
25    
26    diag "debug level for $0 is $debug" if ($debug);
27    if ($debug > 2) {
28            diag "debug level for WebPAC::Normalize is ", _debug( $debug - 2 );
29    }
30    
31  ok(my $abs_path = abs_path($0), "abs_path");  ok(my $abs_path = abs_path($0), "abs_path");
32  $abs_path =~ s#/[^/]*$#/#;  $abs_path =~ s#/[^/]*$#/#;
33  diag "abs_path: $abs_path" if ($debug);  diag "abs_path: $abs_path" if ($debug);
# Line 109  my $lookup2 = { Line 122  my $lookup2 = {
122    
123    
124  sub test {  sub test {
125          print Dumper( @_ ), ("-" x 78), "\n";          print dump( @_ ), ("-" x 78), "\n";
126          ok( defined(@_) );          ok( defined(@_) );
127  }  }
128    
# Line 144  sub test_s { Line 157  sub test_s {
157          no strict 'subs';          no strict 'subs';
158          use WebPAC::Normalize;          use WebPAC::Normalize;
159    
160          ok(! set_lookup( undef ), "set_lookup(undef)");          ok(! _set_lookup( undef ), "set_lookup(undef)");
161    
162          set_rec( $rec1 );          _set_rec( $rec1 );
163    
164          cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' );          cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' );
165          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' );
# Line 165  sub test_s { Line 178  sub test_s {
178          cmp_ok( join('', surround('->', '<-', 'a','b','c') ), 'eq', '->a<-->b<-->c<-', 'surround');          cmp_ok( join('', surround('->', '<-', 'a','b','c') ), 'eq', '->a<-->b<-->c<-', 'surround');
179    
180    
181          set_lookup( $lookup1 );          _set_lookup( $lookup1 );
182                    
183          cmp_ok(          cmp_ok(
184                  join_with(" i ",                  join_with(" i ",
# Line 219  sub test_s { Line 232  sub test_s {
232    
233          # test lookups          # test lookups
234    
235          set_lookup( $lookup2 );          _set_lookup( $lookup2 );
236    
237          is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' );          is_deeply( \[ lookup( prefix( '00', rec('902') ) ) ], \[ 'lookup' ], 'lookup prefix' );
238    
239          ok(! lookup('non-existent'), 'lookup non-existant' );          ok(! lookup('non-existent'), 'lookup non-existant' );
240    
241          set_rec( $rec2 );          _set_rec( $rec2 );
242    
243          test_s(qq{          test_s(qq{
244                  tag('Title',                  tag('Title',
# Line 255  sub test_s { Line 268  sub test_s {
268                  )                  )
269          });          });
270    
271          ok(my $ds = get_ds(), "get_ds");          ok(my $ds = _get_ds(), "get_ds");
272          diag "ds = ", Dumper($ds) if ($debug);          diag "ds = ", dump($ds) if ($debug);
273    
274    
275          sub test_check_ds {          sub test_check_ds {
276    
277                  my $t = shift;                  my $t = shift;
278    
279                  ok($ds = get_ds(), 'get_ds');                  ok($ds = _get_ds(), 'get_ds');
280                  diag Dumper( $ds ) if ($debug);                  diag dump( $ds ) if ($debug);
281    
282                  ok( $ds && $ds->{something}, 'get_ds->something exists' );                  ok( $ds && $ds->{something}, 'get_ds->something exists' );
283                  ok( $ds && $ds->{something}->{$t}, 'get_ds->something->'.$t.' exists') if ($t);                  ok( $ds && $ds->{something}->{$t}, 'get_ds->something->'.$t.' exists') if ($t);
# Line 273  sub test_s { Line 286  sub test_s {
286                  return $ds;                  return $ds;
287          }          }
288    
289          clean_ds();          _clean_ds();
290          test_s(qq{ search('something', '42'); });          test_s(qq{ search('something', '42'); });
291          test_s(qq{ search('empty', ''); });          test_s(qq{ search('empty', ''); });
292          test_check_ds('search');          test_check_ds('search');
293    
294          clean_ds();          _clean_ds();
295          test_s(qq{ display('something', '42'); });          test_s(qq{ display('something', '42'); });
296          test_s(qq{ display('empty', ''); });          test_s(qq{ display('empty', ''); });
297          test_check_ds('display');          test_check_ds('display');
298    
299          clean_ds();          _clean_ds();
300          test_s(qq{ tag('something', '42'); });          test_s(qq{ tag('something', '42'); });
301          test_s(qq{ tag('empty', ''); });          test_s(qq{ tag('empty', ''); });
302          test_check_ds('search');          test_check_ds('search');
303          test_check_ds('display');          test_check_ds('display');
304    
305          clean_ds();          _clean_ds();
306          my $n = read_file( "$abs_path/data/normalize.pl" );          my $n = read_file( "$abs_path/data/normalize.pl" );
307          $n .= "\n1;\n";          $n .= "\n1;\n";
308          #diag "normalize code:\n$n\n";          #diag "normalize code:\n$n\n";
309          test_s( $n );          test_s( $n );
310    
311          ok($ds = get_ds(), "get_ds");          ok($ds = _get_ds(), "get_ds");
312          diag "ds = ", Dumper($ds) if ($debug);          diag "ds = ", dump($ds) if ($debug);
313    
314          my $rec = {          my $rec = {
315                  '200' => [{                  '200' => [{
# Line 306  sub test_s { Line 319  sub test_s {
319          };          };
320          my $rules = qq{ search('mixed', rec('200') ) };          my $rules = qq{ search('mixed', rec('200') ) };
321                    
322          clean_ds();          _clean_ds();
323          set_rec( $rec );          _set_rec( $rec );
324          test_s( $rules );          test_s( $rules );
325          ok($ds = get_ds(), "get_ds");          ok($ds = _get_ds(), "get_ds");
326          is_deeply( $ds, {          is_deeply( $ds, {
327                  'mixed' => {                  'mixed' => {
328                          'search' => [ '200a', '200b' ],                          'search' => [ '200a', '200b' ],
# Line 324  sub test_s { Line 337  sub test_s {
337          is_deeply( $ds, $ds2, 'data_structure(s) same');          is_deeply( $ds, $ds2, 'data_structure(s) same');
338    
339          # wird and non-valid structure which is supported anyway          # wird and non-valid structure which is supported anyway
340          clean_ds();          _clean_ds();
341          set_rec({          _set_rec({
342                  '200' => [{                  '200' => [{
343                          'a' => '200a',                          'a' => '200a',
344                  },                  },
# Line 333  sub test_s { Line 346  sub test_s {
346                  ]                  ]
347          });          });
348          test_s(qq{ search('mixed', rec('200') ) });          test_s(qq{ search('mixed', rec('200') ) });
349          ok($ds = get_ds(), "get_ds");          ok($ds = _get_ds(), "get_ds");
350          is_deeply( $ds, {          is_deeply( $ds, {
351                  'mixed' => {                  'mixed' => {
352                          'search' => [ '200a', '200-solo' ],                          'search' => [ '200a', '200-solo' ],
# Line 341  sub test_s { Line 354  sub test_s {
354                  }                  }
355          }, 'correct get_ds');          }, 'correct get_ds');
356    
357            #
358            # MARC
359            #
360    
361            test_s(qq{ marc_indicators('900',1,2) });
362            test_s(qq{ marc('900','a', rec('200') ) });
363            my @marc;
364            ok(@marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields");
365            diag dump( \@marc ) if ($debug);
366    
367            is_deeply( \@marc, [
368                    [ '900', 1, 2, 'a', '200a' ],
369                    [ '900', 1, 2, 'a', '200-solo' ]
370            ], 'correct marc with indicators');
371    
372            test_s(qq{ marc_indicators('900',' ',9) });
373            test_s(qq{ marc_repeatable_subfield('900','a', rec('200') ) });
374    
375            ok(@marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields");
376            diag dump( \@marc ) if ($debug);
377    
378            is_deeply( \@marc, [
379                    [ '900', 1, 2, 'a', '200a', 'a', '200-solo' ],
380                    [ '900', ' ', 9, 'a', '200a', 'a', '200-solo' ]
381            ], 'correct marc with repetable subfield');
382    
383            #
384            # test magic re-ordering of input data
385            #
386    
387            sub test_rec_rules {
388                    my ($msg, $rec, $rules, $struct) = @_;
389    
390                    _clean_ds();
391                    _set_rec($rec);
392    
393                    foreach my $r (split(/;/, $rules)) {
394                            $r =~ s/[\s\n\r]+/ /gs;
395                            $r =~ s/^\s+//gs;
396                            $r =~ s/\s+$//gs;
397                            test_s($r) if ($r);
398                    }
399    
400                    ok(@marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields");
401                    diag dump( \@marc ) if ($debug);
402    
403                    is_deeply( \@marc, $struct, $msg );
404            }
405    
406            test_rec_rules(
407                    'correct marc with repetable subfield',
408                    {
409                            '200' => [{
410                                    'a' => '200a-1',
411                                    'b' => '200b-1',
412                                    'c' => '200c-1',
413                            }, {
414                                    'a' => '200a-2',
415                                    'b' => '200b-2',
416                            }, {
417                                    'a' => '200a-3',
418                            }],
419                    },
420                    qq{
421                            marc_indicators('900',1 ,0);
422                            marc('900','a', rec('200','a') );
423                            marc('900','b', rec('200','b') );
424                            marc('900','c', rec('200','c') );
425                    },
426                    [
427                            [ '900', 1, 0, 'a', '200a-1', 'b', '200b-1', 'c', '200c-1' ],
428                            [ '900', 1, 0, 'a', '200a-2', 'b', '200b-2' ],
429                            [ '900', 1, 0, 'a', '200a-3' ],
430                    ],
431            );
432    
433    
434            test_rec_rules(
435                    'marc_repeatable_subfield',
436                    {
437                            '200' => [{
438                                    'a' => '200a-1',
439                                    'b' => '200b-1',
440                                    'c' => '200c-1',
441                            }, {
442                                    'a' => '200a-2',
443                                    'b' => '200b-2',
444                                    'c' => '200c-2',
445                            }, {
446                                    'a' => '200a-3',
447                                    'c' => '200c-3',
448                            }],
449                    },
450                    qq{
451                            marc_indicators('900',1 ,0);
452                            marc_repeatable_subfield('900','a', rec('200','a') );
453                            marc('900','b', rec('200','b') );
454                            marc('900','c', rec('200','c') );
455                    },
456                    [
457                            [ '900', 1, 0, 'a', '200a-1', 'a', '200a-2', 'a', '200a-3', 'b', '200b-1', 'c', '200c-1' ],
458                            [ '900', 1, 0, 'b', '200b-2', 'c', '200c-2' ],
459                            [ '900', 1, 0, 'c', '200c-3' ],
460                    ],
461            );
462  }  }
463    
Legend:
Removed from v.536  
changed lines
  Added in v.555
  ViewVC Help
Powered by ViewVC 1.1.26