| Line 0
          
      
      
        Link Here | 
          
            
              | 0 | -  | 1 | #!/usr/bin/perl | 
            
              |  |  | 2 |  | 
            
              | 3 | # Copyright 2014 Rijksmuseum | 
            
              | 4 | # | 
            
              | 5 | # This file is part of Koha. | 
            
              | 6 | # | 
            
              | 7 | # Koha is free software; you can redistribute it and/or modify it under the | 
            
              | 8 | # terms of the GNU General Public License as published by the Free Software | 
            
              | 9 | # Foundation; either version 3 of the License, or (at your option) any later | 
            
              | 10 | # version. | 
            
              | 11 | # | 
            
              | 12 | # Koha is distributed in the hope that it will be useful, but WITHOUT ANY | 
            
              | 13 | # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR | 
            
              | 14 | # A PARTICULAR PURPOSE.  See the GNU General Public License for more details. | 
            
              | 15 | # | 
            
              | 16 | # You should have received a copy of the GNU General Public License along | 
            
              | 17 | # with Koha; if not, write to the Free Software Foundation, Inc., | 
            
              | 18 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | 
            
              | 19 |  | 
            
              | 20 | use Modern::Perl; | 
            
              | 21 |  | 
            
              | 22 | use C4::Context; | 
            
              | 23 | use C4::Biblio; | 
            
              | 24 | use misc::migration_tools::ZebraExclude; | 
            
              | 25 |  | 
            
              | 26 | use MARC::Record; | 
            
              | 27 | use MARC::File::XML; | 
            
              | 28 | use Test::More tests => 2; | 
            
              | 29 |  | 
            
              | 30 | my $dbh = C4::Context->dbh; | 
            
              | 31 | $dbh->{AutoCommit} = 0; | 
            
              | 32 | $dbh->{RaiseError} = 1; | 
            
              | 33 |  | 
            
              | 34 | subtest '01parse' => sub { | 
            
              | 35 |     plan tests => 17; | 
            
              | 36 |     test_parsing_pref(); | 
            
              | 37 | }; | 
            
              | 38 | subtest '02exclude' => sub { | 
            
              | 39 |     plan tests => 12; | 
            
              | 40 |     test_exclude(); | 
            
              | 41 | }; | 
            
              | 42 |  | 
            
              | 43 | $dbh->rollback; | 
            
              | 44 |  | 
            
              | 45 | sub test_parsing_pref { | 
            
              | 46 |     my ($excl, @a, @b, $hash, $reg); | 
            
              | 47 |  | 
            
              | 48 |     $dbh->do("DELETE FROM systempreferences where variable='ZebraExclude'"); | 
            
              | 49 |     is( defined load_zebra_exclude(), '', 'Test without pref'); | 
            
              | 50 |  | 
            
              | 51 |     C4::Context->set_preference('ZebraExclude', '590,952e'); | 
            
              | 52 |     $excl = load_zebra_exclude(); | 
            
              | 53 |     @a= @{$excl->{list}}; | 
            
              | 54 |     is( @a, 1, 'Expect one parsed line'); | 
            
              | 55 |     ($hash, $reg) = @{$a[0]}; | 
            
              | 56 |     is( defined $reg, '', 'No regex in first line' ); | 
            
              | 57 |     @b= @{$hash->{field}}; | 
            
              | 58 |     is( @b, 1, 'Expect one whole field' ); | 
            
              | 59 |     is( $b[0], '590', 'Should be 590' ); | 
            
              | 60 |     @b= @{$hash->{subfield}}; | 
            
              | 61 |     is( @b, 1, 'Expect one subfield' ); | 
            
              | 62 |     is( $b[0][0] eq '952' && $b[0][1] eq 'e', 1, 'Should be 952e' ); | 
            
              | 63 |  | 
            
              | 64 |     C4::Context->set_preference('ZebraExclude', "\n/\// : 590, 8XX, nothing\n"); | 
            
              | 65 |     $excl = load_zebra_exclude(); | 
            
              | 66 |     @a= @{$excl->{list}}; | 
            
              | 67 |     is( @a, 1, 'Expect one parsed line'); | 
            
              | 68 |     ($hash, $reg) = @{$a[0]}; | 
            
              | 69 |     is( $reg, '/', 'Check regex /' ); | 
            
              | 70 |     @b= @{$hash->{field}}; | 
            
              | 71 |     is( @b, 1, 'Expect one whole field' ); | 
            
              | 72 |     @b= @{$hash->{wildcard}}; | 
            
              | 73 |     is( @b, 1, 'Expect one wildcard' ); | 
            
              | 74 |  | 
            
              | 75 |     C4::Context->set_preference('ZebraExclude', '/Garbage[/: 9XX'); | 
            
              | 76 |     $excl = load_zebra_exclude(); | 
            
              | 77 |     @a= @{$excl->{list}}; | 
            
              | 78 |     ($hash, $reg) = @{$a[0]}; | 
            
              | 79 |     is( $reg, undef, 'Wrong regex with only [' ); | 
            
              | 80 |  | 
            
              | 81 |     C4::Context->set_preference('ZebraExclude', | 
            
              | 82 |         "/_skip_/: XXX\n". | 
            
              | 83 |         "//: 590, 920, 952e\n" | 
            
              | 84 |     ); | 
            
              | 85 |     $excl = load_zebra_exclude(); | 
            
              | 86 |     @a= @{$excl->{list}}; | 
            
              | 87 |     is( @a, 2, 'Expect two parsed lines'); | 
            
              | 88 |     ($hash, $reg) = @{$a[0]}; | 
            
              | 89 |     is( $reg, '_skip_', 'Check regex _skip_' ); | 
            
              | 90 |     ($hash, $reg) = @{$a[1]}; | 
            
              | 91 |     @b= @{$hash->{wildcard}}; | 
            
              | 92 |     is( @b, 0, 'Expect no wildcard for line 2' ); | 
            
              | 93 |     @b= @{$hash->{field}}; | 
            
              | 94 |     is( @b, 2, 'Expect two whole fields' ); | 
            
              | 95 |     @b= @{$hash->{subfield}}; | 
            
              | 96 |     is( @b, 1, 'Expect one subfield' ); | 
            
              | 97 | } | 
            
              | 98 |  | 
            
              | 99 | sub test_exclude { | 
            
              | 100 |     my ( $marc, $rv, $excl, $c1, $c2, @f ); | 
            
              | 101 |  | 
            
              | 102 |     C4::Context->set_preference('ZebraExclude', '590,952e'); | 
            
              | 103 |     $excl = load_zebra_exclude(); | 
            
              | 104 |     $marc= mybiblio(); | 
            
              | 105 |     $c1 = scalar $marc->fields; | 
            
              | 106 |     $rv = exclude_fields( $marc, $excl ); | 
            
              | 107 |     $c2 = scalar $marc->fields; | 
            
              | 108 |     is( $rv, 1, 'Checked return value' ); | 
            
              | 109 |     is( $c1-$c2, 2, 'Expected two fields less' ); | 
            
              | 110 |     is( $marc->field('590'), undef, 'No field 590' ); | 
            
              | 111 |     @f = $marc->field('952'); | 
            
              | 112 |     is( @f, 1, 'One field 952' ); | 
            
              | 113 |     is( $marc->subfield('952', 'o'), '123 A 456', 'Checked 952$o' ); | 
            
              | 114 |  | 
            
              | 115 |     C4::Context->set_preference('ZebraExclude', '/Garbage/:XXX'); | 
            
              | 116 |     $excl = load_zebra_exclude(); | 
            
              | 117 |     $marc= mybiblio(); | 
            
              | 118 |     $rv = exclude_fields( $marc, $excl ); | 
            
              | 119 |     is( $rv, undef, 'Checked return value with Garbage' ); | 
            
              | 120 |     C4::Context->set_preference('ZebraExclude', '/G@rb@ge/:XXX'); | 
            
              | 121 |     $excl = load_zebra_exclude(); | 
            
              | 122 |     $marc= mybiblio(); | 
            
              | 123 |     $c1 = scalar $marc->fields; | 
            
              | 124 |     $rv = exclude_fields( $marc, $excl ); | 
            
              | 125 |     $c2 = scalar $marc->fields; | 
            
              | 126 |     is( $rv, 1, 'Checked return value with G@rb@ge' ); | 
            
              | 127 |     is( $c1, $c2, 'Checked number of fields for G@rb@ge' ); | 
            
              | 128 |  | 
            
              | 129 |     C4::Context->set_preference('ZebraExclude', | 
            
              | 130 |         "/local note/: 590a\n". | 
            
              | 131 |         "/Author2/: 1XX\n". | 
            
              | 132 |         "/Author1/: 245, 3XX, 9XX\n" | 
            
              | 133 |     ); | 
            
              | 134 |     $excl = load_zebra_exclude(); | 
            
              | 135 |     $marc= mybiblio(); | 
            
              | 136 |     $c1 = scalar $marc->fields; | 
            
              | 137 |     $rv = exclude_fields( $marc, $excl ); | 
            
              | 138 |     $c2 = scalar $marc->fields; | 
            
              | 139 |     is( $c1-$c2, 5, 'Expected 5 fields less' ); | 
            
              | 140 |     is( $marc->field('245'), undef, 'No field 245' ); | 
            
              | 141 |     is( $marc->field('952'), undef, 'No fields 952' ); | 
            
              | 142 |     is( defined $marc->field('999'), 1, 'Field 999 should still be there' ); | 
            
              | 143 | } | 
            
              | 144 |  | 
            
              | 145 | sub mybiblio { | 
            
              | 146 |     my $marc= MARC::Record->new; | 
            
              | 147 |     my @fld= ( | 
            
              | 148 |         MARC::Field->new('001', 12345), | 
            
              | 149 |         MARC::Field->new('100', '', '', a => 'Author1' ), | 
            
              | 150 |         MARC::Field->new('245', '', '', a => 'Just a title' ), | 
            
              | 151 |         MARC::Field->new('500', '', '', a => 'Just a note' ), | 
            
              | 152 |         MARC::Field->new('590', '', '', a => 'Just a local note' ), | 
            
              | 153 |         MARC::Field->new('920', '', '', a => 'Garbage' ), | 
            
              | 154 |         MARC::Field->new('952', '', '', e => 'acqsource', o => '123 A 456' ), | 
            
              | 155 |         MARC::Field->new('952', '', '', e => 'only sub' ), | 
            
              | 156 |         MARC::Field->new('999', '', '', c => 12345, d => 12345 ), | 
            
              | 157 |     ); | 
            
              | 158 |     $marc->append_fields(@fld); | 
            
              | 159 |     return $marc; | 
            
              | 160 | } |