git.rot13.org Git - webpac2/blob - t/3-normalize-marc.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use blib;
   5
   6 use Test::More tests => 325;
   7
   8 BEGIN {
   9         use_ok( 'WebPAC::Test' );
  10         use_ok( 'WebPAC::Normalize' );
  11         use_ok( 'WebPAC::Normalize::MARC' );
  12 }
  13
  14 _debug( $debug - 1 ) if $debug > 1;
  15
  16 my $rec = {
  17         '225' => [{
  18                 'a' => 'a-1-1',
  19                 'i' => 'i-1-1',
  20                 'v' => 'v-1-1',
  21                 'w' => 'w-1-1',
  22                 'h' => 'h-1-1',
  23                 'x' => 'x-1-1',
  24         },{
  25                 'a' => 'a-2-1',
  26                 'v' => 'v-2-1',
  27                 'i' => 'i-2-1',
  28         },{
  29                 'a' => 'a-3-1',
  30                 'i' => 'i-3-1',
  31                 'v' => 'v-3-1',
  32         },{
  33                 'a' => 'a-4-1',
  34                 'v' => 'v-4-1',
  35                 'i' => 'i-4-1',
  36                 'w' => 'w-4-1',
  37         },{
  38                 'a' => 'a-5-1',
  39                 'v' => 'v-5-1',
  40                 'i' => 'i-5-1',
  41         },{
  42                 'a' => 'a-6-1',
  43                 'i' => 'i-6-1',
  44                 'w' => 'w-6-1',
  45         },{
  46                 'a' => 'a-7-1',
  47         },{
  48                 'a' => 'a-8-1',
  49                 'v' => 'v-8-1',
  50         },{
  51                 'v' => 'v-9-1',
  52         },{
  53                 'v' => '0',
  54         }],
  55 };
  56
  57 sub test_marc_template {
  58         my $rec = shift;
  59
  60         ok( _clean_ds(), '_clean_ds' );
  61         ok( _set_ds( $rec ), '_set_ds' );
  62
  63         ok( marc_indicators( 440, '0', '1' ), 'marc_indicators' );
  64
  65         ok( marc_template(
  66                 from => 225, to => 440,
  67                 subfields_rename => [
  68                         'a' => 'a',
  69                         'x' => 'x',
  70                         'v' => 'v',
  71                         'h' => 'n',
  72                         'i' => 'p',
  73                         'w' => 'v',
  74                 ],
  75                 isis_template => [
  76                         'a ; |v. |i',
  77                         'a. |i ; |w',
  78                 ],
  79                 marc_template => [
  80                         'a',
  81                         'a ;|v',
  82                         'a.|p',
  83                         'a, |x ; |v. |n, |p ; |v',
  84                         'a ; |v. |p ; |v',
  85                         'v',
  86                 ],
  87         ), 'marc_template' );
  88
  89         ok(my $marc = WebPAC::Normalize::MARC::_get_marc_fields(), "_get_marc_fields");
  90         diag " _get_marc_fields = ",dump( $marc ) if $debug;
  91
  92         ok( marc_indicators( 440, 'x', 'y' ), 'marc_indicators' );
  93
  94         return $marc;
  95 }
  96
  97 my $marc_out = [
  98         [440, "0", "1", "a", "a-1-1, ", "x", "x-1-1 ; ", "v", "v-1-1. ", "n", "h-1-1, ", "p", "i-1-1 ; ", "v", "w-1-1"],
  99         [440, "0", "1", "a", "a-2-1 ; ", "v", "v-2-1. ", "p", "i-2-1"],
 100         [440, "0", "1", "a", "a-3-1 ; ", "v", "v-3-1. ", "p", "i-3-1"],
 101         [440, "0", "1", "a", "a-4-1 ; ", "v", "v-4-1. ", "p", "i-4-1 ; ", "v", "w-4-1"],
 102         [440, "0", "1", "a", "a-5-1 ; ", "v", "v-5-1. ", "p", "i-5-1"],
 103         [440, "0", "1", "a", "a-6-1. ", "p", "i-6-1 ; ", "v", "w-6-1"],
 104         [440, "0", "1", "a", "a-7-1"],
 105         [440, "0", "1", "a", "a-8-1 ;", "v", "v-8-1"],
 106         [440, "0", "1", "v", "v-9-1"],
 107         [440, 0, 1, "v", 0],
 108 ];
 109
 110 is_deeply( test_marc_template($rec), $marc_out , 'is_deeply');
 111
 112 my $max_occ = $#{ $rec->{225} };
 113
 114 foreach my $from ( 0 .. $max_occ - 1 ) {
 115         foreach my $to ( $from + 1 .. $max_occ ) {
 116                 my @orig_rec = @{ $rec->{225} };
 117                 my $new_rec = {
 118                         225 => [ splice( @orig_rec, $from, $to ) ],
 119                 };
 120                 diag "$from-$to new_rec = ",dump( $new_rec ) if $debug;
 121
 122                 my @expect = @$marc_out;
 123                 my $expect_marc = [ splice( @expect, $from, $to ) ];
 124                 diag "$from-$to expect_marc = ",dump( $expect_marc ) if $debug;
 125
 126                 is_deeply( test_marc_template($new_rec), $expect_marc, "$from-$to is_deeply");
 127
 128         }
 129 }