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 <[email protected]> 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 _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
