[libcatmandu-marc-perl] 40/208: gh#37: fix marc_each()

Jonas Smedegaard dr at jones.dk
Sat Oct 28 03:42:33 UTC 2017


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 ecee3123123eb8126c46dbe60a7df0c8cacd245b
Author: Johann Rolschewski <jorol at cpan.org>
Date:   Thu Aug 25 15:17:12 2016 +0200

    gh#37: fix marc_each()
---
 lib/Catmandu/Fix/Bind/marc_each.pm | 2 +-
 t/16-marc-each.t                   | 9 +++++++--
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/lib/Catmandu/Fix/Bind/marc_each.pm b/lib/Catmandu/Fix/Bind/marc_each.pm
index 103f7fd..b0d4c7a 100644
--- a/lib/Catmandu/Fix/Bind/marc_each.pm
+++ b/lib/Catmandu/Fix/Bind/marc_each.pm
@@ -32,7 +32,7 @@ sub bind {
 
         my $fixed = $fixer->fix($mvar);
 
-        push @new , @{$fixed->{record}} if defined($fixed) && exists $fixed->{record};
+        push @new , @{$fixed->{record}} if defined $fixed && exists $fixed->{record} && defined $fixed->{record};
     }
 
     $mvar->{record} = \@new if exists $mvar->{record};
diff --git a/t/16-marc-each.t b/t/16-marc-each.t
index a5bb919..90659d4 100644
--- a/t/16-marc-each.t
+++ b/t/16-marc-each.t
@@ -25,8 +25,12 @@ my $fixer = Catmandu::Fix->new(fixes => [q|
 		if marc_match("100",'.*')
 			reject()
 		end
+		if marc_match(245a,'.*')
+			marc_remove(245)
+		end
 	end
-	marc_map("100",test)
+	marc_map("100",mainentry)
+	marc_map("245",title)
 |]);
 
 my $importer = Catmandu::Importer::MARC->new( file => 't/camel.usmarc', type => "USMARC" );
@@ -37,7 +41,8 @@ $fixer->fix($importer)->each(sub {
 
 	ok exists $record->{record}, "created a marc record $id";
 	is $record->{has_perl}, 'true', "created has_dlc tag $id";
-	ok ! exists $record->{test} , "field 300 deleted $id";
+	ok ! exists $record->{mainentry} , "field 100 deleted $id";
+	ok ! exists $record->{title} , "field 245 deleted $id";
 });
 
 done_testing;
\ No newline at end of file

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



More information about the Pkg-perl-cvs-commits mailing list