/[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 923 by dpavlin, Wed Oct 31 00:26:43 2007 UTC revision 1341 by dpavlin, Fri Oct 15 13:36:56 2010 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl -w  #!/usr/bin/perl -w
2    
3  use strict;  use strict;
4    use lib 'lib';
5    
6  use Test::More tests => 347;  use Test::More tests => 357;
7  use Test::Exception;  
8  use Cwd qw/abs_path/;  use utf8;
 use blib;  
 use File::Slurp;  
 use Getopt::Long;  
9    
10  BEGIN {  BEGIN {
11            use_ok( 'WebPAC::Test' );
12          use_ok( 'WebPAC::Normalize' );          use_ok( 'WebPAC::Normalize' );
13  }  }
14    
 use Data::Dump qw/dump/;  
   
 my $debug = 0;  
 GetOptions(  
         "debug+", \$debug  
 );  
   
15  cmp_ok(_debug(1), '==', 1, '_debug level');  cmp_ok(_debug(1), '==', 1, '_debug level');
16  cmp_ok(_debug(0), '==', 0, '_debug level');  cmp_ok(_debug(0), '==', 0, '_debug level');
17    
# Line 28  if ($debug > 2) { Line 20  if ($debug > 2) {
20          diag "debug level for WebPAC::Normalize is ", _debug( $debug - 2 );          diag "debug level for WebPAC::Normalize is ", _debug( $debug - 2 );
21  }  }
22    
 ok(my $abs_path = abs_path($0), "abs_path");  
 $abs_path =~ s#/[^/]*$#/#;  
 diag "abs_path: $abs_path" if ($debug);  
   
23  my $rec1 = {  my $rec1 = {
24          '200' => [{          '200' => [{
25                  'a' => '200a',                  'a' => '200a',
# Line 69  my $rec2 = { Line 57  my $rec2 = {
57              } ],              } ],
58   '700' => [ {   '700' => [ {
59                'a' => 'Haynal',                'a' => 'Haynal',
60                'b' => 'André'                'b' => 'André'
61              } ],              } ],
62   '801' => [ 'FFZG' ],   '801' => [ 'FFZG' ],
63   '991' => [ '8302' ],   '991' => [ '8302' ],
# Line 92  my $rec2 = { Line 80  my $rec2 = {
80                'e' => 'from Freud and Ferenczi to Michael balint',                'e' => 'from Freud and Ferenczi to Michael balint',
81                'a' => 'Controversies in psychoanalytic method',                'a' => 'Controversies in psychoanalytic method',
82                'g' => 'translated by Elizabeth Holder on the basisi of a first draft by Archie Hooton ; with a preface by Daniel N. Stern',                'g' => 'translated by Elizabeth Holder on the basisi of a first draft by Archie Hooton ; with a preface by Daniel N. Stern',
83                'f' => 'by André E. Haynal'                'f' => 'by André E. Haynal'
84              } ],              } ],
85   '610' => [ 'povijest psihoanalize' ],   '610' => [ 'povijest psihoanalize' ],
86   '994' => [ {   '994' => [ {
# Line 176  sub test_s { Line 164  sub test_s {
164    
165          ok(! _set_lookup( undef ), "set_lookup(undef)");          ok(! _set_lookup( undef ), "set_lookup(undef)");
166    
167          _set_rec( $rec1 );          _set_ds( $rec1 );
168    
169          cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' );          cmp_ok( join(",", rec2('200','a') ), 'eq', '200a,200a*2', 'join rec2' );
170          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 372  sub test_s { Line 360  sub test_s {
360    
361          #ok(! lookup('non-existent'), 'lookup non-existant' );          #ok(! lookup('non-existent'), 'lookup non-existant' );
362    
363          _set_rec( $rec2 );          _set_ds( $rec2 );
364    
365          test_s(qq{          test_s(qq{
366                  search_display('Title',                  search_display('Title',
# Line 459  sub test_s { Line 447  sub test_s {
447          my $rules = qq{ search('mixed', rec('200') ) };          my $rules = qq{ search('mixed', rec('200') ) };
448                    
449          _clean_ds();          _clean_ds();
450          _set_rec( $rec );          _set_ds( $rec );
451          test_s( $rules );          test_s( $rules );
452          ok($ds = _get_ds(), "get_ds");          ok($ds = _get_ds(), "get_ds");
453          is_deeply( $ds, {          is_deeply( $ds, {
# Line 476  sub test_s { Line 464  sub test_s {
464    
465          # wird and non-valid structure which is supported anyway          # wird and non-valid structure which is supported anyway
466          _clean_ds();          _clean_ds();
467          _set_rec({          _set_ds({
468                  '200' => [{                  '200' => [{
469                          'a' => '200a',                          'a' => '200a',
470                  },                  },
# Line 499  sub test_s { Line 487  sub test_s {
487          test_s(qq{ marc_indicators('900',1,2) });          test_s(qq{ marc_indicators('900',1,2) });
488          test_s(qq{ marc('900','a', rec('200') ) });          test_s(qq{ marc('900','a', rec('200') ) });
489          my $marc;          my $marc;
490          ok($marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields");          ok($marc = WebPAC::Normalize::MARC::_get_marc_fields(), "_get_marc_fields");
491          diag dump( $marc ) if ($debug);          diag dump( $marc ) if ($debug);
492    
493          is_deeply( $marc, [          is_deeply( $marc, [
# Line 510  sub test_s { Line 498  sub test_s {
498          test_s(qq{ marc_indicators('900',' ',9) });          test_s(qq{ marc_indicators('900',' ',9) });
499          test_s(qq{ marc_repeatable_subfield('900','a', rec('200') ) });          test_s(qq{ marc_repeatable_subfield('900','a', rec('200') ) });
500    
501          ok($marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields");          ok($marc = WebPAC::Normalize::MARC::_get_marc_fields(), "_get_marc_fields");
502          diag dump( $marc ) if ($debug);          diag dump( $marc ) if ($debug);
503    
504          is_deeply( $marc, [          is_deeply( $marc, [
# Line 526  sub test_s { Line 514  sub test_s {
514                  my ($msg, $rec, $rules, $struct) = @_;                  my ($msg, $rec, $rules, $struct) = @_;
515    
516                  _clean_ds();                  _clean_ds();
517                  _set_rec($rec);                  _set_ds($rec);
518    
519                  foreach my $r (split(/;/, $rules)) {                  foreach my $r (split(/;\s*$/, $rules)) {
520                          $r =~ s/[\s\n\r]+/ /gs;                          $r =~ s/[\s\n\r]+/ /gs;
521                          $r =~ s/^\s+//gs;                          $r =~ s/^\s+//gs;
522                          $r =~ s/\s+$//gs;                          $r =~ s/\s+$//gs;
523                            diag "rule: $r" if $debug;
524                          test_s($r) if ($r);                          test_s($r) if ($r);
525                  }                  }
526    
527                  ok(my $marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields");                  ok(my $marc = WebPAC::Normalize::MARC::_get_marc_fields(), "_get_marc_fields");
528                  diag dump( $marc ) if ($debug);                  diag dump( $marc ) if $debug;
529                  diag "expects:\n", dump($struct) if ($debug > 1);                  diag "expects:\n", dump($struct) if ($debug > 1);
530                  is_deeply( $marc, $struct, $msg );                  is_deeply( $marc, $struct, $msg );
531          }          }
# Line 635  sub test_s { Line 624  sub test_s {
624          sub test_rule {          sub test_rule {
625                  my ($msg, $rec, $rule, $struct) = @_;                  my ($msg, $rec, $rule, $struct) = @_;
626                  _clean_ds();                  _clean_ds();
627                  _set_rec( $rec );                  _set_ds( $rec );
628                  $rule =~ s/\\/\\/gs;                  $rule =~ s/\\/\\/gs;
629                  my $r = test_s( $rule );                  my $r = test_s( $rule );
630                  diag "for ", dump($rec), " got:\n", dump($r), "\nexpect:\n" if ($debug > 1);                  diag "for ", dump($rec), " got:\n", dump($r), "\nexpect:\n" if ($debug > 1);
# Line 745  sub test_s { Line 734  sub test_s {
734          );          );
735    
736          test_s(qq{ marc_remove('*'); });          test_s(qq{ marc_remove('*'); });
737          ok(! WebPAC::Normalize::_get_marc_fields(), 'marc_remove(*)');          ok(! WebPAC::Normalize::MARC::_get_marc_fields(), 'marc_remove(*)');
738    
739          test_rec_rules(          test_rec_rules(
740                  'marc_duplicate',                  'marc_duplicate',
# Line 779  sub test_s { Line 768  sub test_s {
768          my $i = 0;          my $i = 0;
769          foreach my $v ( qw/bar baz bing bong/ ) {          foreach my $v ( qw/bar baz bing bong/ ) {
770    
771                  ok($marc = WebPAC::Normalize::_get_marc_fields( offset => $i ),                  ok($marc = WebPAC::Normalize::MARC::_get_marc_fields( offset => $i ),
772                          "_get_marc_fields( offset => $i )"                          "_get_marc_fields( offset => $i )"
773                  );                  );
774                  diag "marc $i = ", dump( $marc ) if ($debug);                  diag "marc $i = ", dump( $marc ) if ($debug);
# Line 787  sub test_s { Line 776  sub test_s {
776                          [ [ '900', ' ', ' ', 'a', 42, 'b', $v ] ],                          [ [ '900', ' ', ' ', 'a', 42, 'b', $v ] ],
777                          "MARC copy $i has $v",                          "MARC copy $i has $v",
778                  );                  );
779                  is_deeply(WebPAC::Normalize::_get_marc_leader(), { '06' => 42, 11 => $i }, "_get_marc_leader copy $i");                  is_deeply(WebPAC::Normalize::MARC::_get_marc_leader(), { '06' => 42, 11 => $i }, "_get_marc_leader copy $i");
780                  $i++;                  $i++;
781          }          }
782    
# Line 854  sub test_s { Line 843  sub test_s {
843                  marc_fixed('000', 10, 'A');                  marc_fixed('000', 10, 'A');
844                  marc_fixed('000', 0, '0');                  marc_fixed('000', 0, '0');
845          });          });
846          ok( my $m = WebPAC::Normalize::_get_marc_fields(), '_get_marc_fields');          ok( my $m = WebPAC::Normalize::MARC::_get_marc_fields(), '_get_marc_fields');
847          diag dump( $m );          diag dump( $m );
848          is_deeply( WebPAC::Normalize::_get_marc_fields(),          is_deeply( WebPAC::Normalize::MARC::_get_marc_fields(),
849                  [                  [
850                          ["008", "abcdef"],                          ["008", "abcdef"],
851                          #        0....5....10                          #        0....5....10
852                          ["000", "0    5    A"]                          ["000", "0    5    A"]
853                  ]                  ]
854          );          );
855    
856            test_s(qq{ isbn_13( '1558607013', '978-1558607019' ) });
857            test_s(qq{ isbn_10( '1558607013', '978-1558607019' ) });
858    
859            is_deeply(
860                    [ isbn_13( '1558607013', '978-1558607019' ) ],
861                    [ '978-1-55860-701-9', '978-1-55860-701-9', ],
862            'isbn_13' );
863    
864            is_deeply(
865                    [ isbn_10( '1558607013', '978-1558607019' ) ],
866                    [ '1-55860-701-3', '1-55860-701-3' ],
867            'isbn_10' );
868    
869            # frec
870    
871            $rec = {
872                            '200' => [ {
873                                    a => [ 'a1', 'a2' ], b => [ 'b1', 'b2' ], c => [ 'c1', 'c2' ],
874                                    subfields => [ qw/a 0 b 0 a 1 b 1 c 0 c 1/ ],
875                                    i1 => '0', i2 => '1',
876                            }, {
877                                    a => [ 'a3', 'a4', 'a5' ], b => 'b3', c => 'c3',
878                                    subfields => [ qw/a 0 a 1 b 0 c 0 a 2/ ],
879                            } ],
880            };
881    
882            test_rule( 'frec', $rec, qq{ frec(200) }, [ 'a1' ] );
883            test_rule( 'frec', $rec, qq{ frec(200,'a') }, [ 'a1' ] );
884            test_rule( 'frec', $rec, qq{ frec(200,'b') }, [ 'b1' ] );
885            test_rule( 'frec', $rec, qq{ frec(200,'c') }, [ 'c1' ] );
886    
887            $rec->{'900'} = $rec->{'200'};
888            foreach my $sf ( qw/a b c/ ) {
889                    ok( frec_eq( '200' => $sf, '900' => $sf ), "frec_eq 200 == 900 $sf");
890                    ok( ! frec_ne( '200' => $sf, '900' => $sf ), "! frec_ne 200 == 900 $sf");
891            }
892    
893            foreach my $sf ( qw/a b/ ) {
894                    ok( ! frec_eq( '200' => $sf, '200' => 'c' ), "! frec_eq 200 $sf == 200 c");
895                    ok( frec_ne( '200' => $sf, '200' => 'c' ), "frec_ne 200 $sf == 200 c");
896            }
897    
898            test_rule( 'rec(200,i1)', $rec, qq{ rec(200,'i1') }, [ '0' ] );
899            test_rule( 'rec(200,i2)', $rec, qq{ rec(200,'i2') }, [ '1' ] );
900    
901            my $hash = { a => '[a]', 'b' => '[b]', subfields => [ 'a', 0, 'b', 0 ] };
902            is_deeply([ _pack_subfields_hash( $hash ) ], [ '[a]', '[b]' ], '_pack_subfields_hash' );
903            ok( $hash->{subfields}, 'subfields exist' );
904            cmp_ok( _pack_subfields_hash( $hash, 1 ), 'eq', '^a[a]^b[b]', '_pack_subfields_hash' );
905            ok( $hash->{subfields}, 'subfields exist' );
906    
907            $rec = { 'arr' => [ 1, 2, 3 ] };
908            test_rule( 'rec_array', $rec, qq{ rec_array('arr') }, $rec->{arr} );
909    
910            _clean_ds();
911            _set_ds( $rec );
912            test_s(q{
913                            row( 'table', e => $_ ) foreach ( rec_array('arr') );
914            });
915            ok( my $rows = _get_ds->{_rows}->{table}, 'ds have _rows' );
916    
917            foreach my $i ( 1 .. 3 ) {
918                    cmp_ok( $rows->[ $i - 1 ]->{e}, '==', $i, "e $i" );
919            }
920    
921            test_rule( 'utf-8'
922                    , { '900' => [{ a => 'ÄŒev', b => 'ić' }] }
923                    , qq{ join_with('', rec(900,'a'), 'apÄ', rec(900,'b') ) }
924                    , [ "\x{10C}evap\x{10D}i\x{107}" ]
925            );
926    
927  }  }
928    
Legend:
Removed from v.923  
changed lines
  Added in v.1341
  ViewVC Help
Powered by ViewVC 1.1.26