[libcatmandu-marc-perl] 42/208: Fixing bug in marc_remove when using indicators to filter which (sub)fields to delete

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to annotated tag upstream/1.19
in repository libcatmandu-marc-perl.

commit d1c5708587281e12b871c1e2abe36966e447aeb1
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Fri Aug 26 13:48:19 2016 +0200

    Fixing bug in marc_remove when using indicators to filter which
    (sub)fields to delete
---
 lib/Catmandu/MARC.pm | 27 +++++++++++++++++----------
 t/05-marc_remove.t   | 18 ++++++++++++++++--
 2 files changed, 33 insertions(+), 12 deletions(-)

diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index af38061..0eab28e 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -274,18 +274,24 @@ sub marc_remove {
             ||
             ($context->{is_regex_field} == 1 && $field->[0] =~ $context->{field_regex})
             ) {
-            if (defined $context->{ind1}) {
-                next if (defined $field->[1] && $field->[1] eq $context->{ind1});
-            }
 
-            if (defined $context->{ind2}) {
-                next if (defined $field->[2] && $field->[2] eq $context->{ind2});
+            my $ind_match = undef;
+
+            if (defined $context->{ind1} && defined $context->{ind2}) {
+                $ind_match = 1 if (defined $field->[1] && $field->[1] eq $context->{ind1} &&
+                                   defined $field->[2] && $field->[2] eq $context->{ind2});
+            }
+            elsif (defined $context->{ind1}) {
+                $ind_match = 1 if (defined $field->[1] && $field->[1] eq $context->{ind1});
+            }
+            elsif (defined $context->{ind2}) {
+                $ind_match = 1 if (defined $field->[2] && $field->[2] eq $context->{ind2});
+            }
+            else {
+                $ind_match = 1;
             }
 
-            unless (
-                defined $context->{ind1} ||
-                defined $context->{ind2} ||
-                defined $context->{subfield_regex} ) {
+            if ($ind_match && ! defined $context->{subfield_regex}) {
                 next;
             }
 
@@ -298,7 +304,8 @@ sub marc_remove {
                         push @$new_subf , $field->[$i+1];
                     }
                 }
-                splice @$field , $context->{start} , int(@$field), @$new_subf;
+
+                splice @$field , $context->{start} , int(@$field), @$new_subf if $ind_match;
             }
         }
 
diff --git a/t/05-marc_remove.t b/t/05-marc_remove.t
index 33e822c..40799e3 100644
--- a/t/05-marc_remove.t
+++ b/t/05-marc_remove.t
@@ -11,24 +11,38 @@ use Catmandu::Importer::MARC;
 use Catmandu::Fix;
 use Catmandu::Fix::Inline::marc_map qw(:all);
 
-my $fixer = Catmandu::Fix->new(fixes => [q|marc_remove('245')|,q|marc_remove('100a')|]);
+my $fixer = Catmandu::Fix->new(fixes => [
+                q|marc_remove('245')|,
+                q|marc_remove('100a')|,
+                q|marc_remove('082[1,1]a')|,
+                q|marc_remove('050[,0]ab')|,
+                ]);
 my $importer = Catmandu::Importer::MARC->new( file => 't/camel.usmarc', type => "USMARC" );
 my $record = $importer->first;
 
 my $title  = marc_map($record,'245');
 my $author = marc_map($record,'100');
+my $dewey  = marc_map($record,'082');
+my $lccn   = marc_map($record,'050');
 
 ok  $title, 'got a title';
 like $author , qr/^Martinsson, Tobias,1976-$/ , 'got an author';
+ok $dewey, 'got a dewey';
+ok $lccn , 'got a lccn';
 
 my $fixed_record = $fixer->fix($record);
 
 my $title2  = marc_map($fixed_record,'245');
 my $author2 = marc_map($fixed_record,'100');
+my $dewey2  = marc_map($fixed_record,'082');
+my $lccn2   = marc_map($fixed_record,'050');
 
 ok (!defined $title2, 'deleted the title');
 
 like $author2 , qr/^1976-$/ , 'removed 100-a';
 
-done_testing 4;
+ok (defined $dewey2, 'didnt delete dewey');
 
+ok (!defined $lccn2, 'deleted lccn');
+
+done_testing 8;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-marc-perl.git