[libcatmandu-marc-perl] 02/26: Making ISO exports better resistent to bad data
Jonas Smedegaard
dr at jones.dk
Tue Dec 19 12:17:03 UTC 2017
This is an automated email from the git hooks/post-receive script.
js pushed a commit to annotated tag upstream/1.23.1
in repository libcatmandu-marc-perl.
commit eb9b3168280efc690ee828bd8f851f9a776ecee9
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Wed Nov 8 10:28:28 2017 +0100
Making ISO exports better resistent to bad data
---
Changes | 2 ++
lib/Catmandu/Exporter/MARC/ALEPHSEQ.pm | 3 +++
lib/Catmandu/Exporter/MARC/Base.pm | 17 ++++++++++++-----
lib/Catmandu/Fix/marc_copy.pm | 2 ++
lib/Catmandu/Fix/marc_cut.pm | 2 ++
t/Catmandu/Exporter/MARC/ISO.t | 28 ++++++++++++++++++++++++++++
t/Catmandu/Exporter/MARC/MARCMaker.t | 26 ++++++++++++++++++++++++++
7 files changed, 75 insertions(+), 5 deletions(-)
diff --git a/Changes b/Changes
index 3635dd6..d7659d8 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
Revision history for Catmandu-MARC
{{$NEXT}}
+ - More stable ISO exports for bad records
+ - More POD
1.19 2017-10-02 11:16:17 CEST
- Adding marc_all_match
diff --git a/lib/Catmandu/Exporter/MARC/ALEPHSEQ.pm b/lib/Catmandu/Exporter/MARC/ALEPHSEQ.pm
index a1c7568..9ff7524 100644
--- a/lib/Catmandu/Exporter/MARC/ALEPHSEQ.pm
+++ b/lib/Catmandu/Exporter/MARC/ALEPHSEQ.pm
@@ -101,6 +101,9 @@ sub add {
next if $#data == -1;
# Joins are faster than perl string concatenation
+ if (@data < 2) {
+ $self->log->warn("$tag doesn't have any data");
+ }
if (index($tag,'LDR') == 0) {
my $ldr = $data[1];
$ldr =~ s/ /^/og;
diff --git a/lib/Catmandu/Exporter/MARC/Base.pm b/lib/Catmandu/Exporter/MARC/Base.pm
index 287b2f1..9f7d986 100644
--- a/lib/Catmandu/Exporter/MARC/Base.pm
+++ b/lib/Catmandu/Exporter/MARC/Base.pm
@@ -7,12 +7,20 @@ our $VERSION = '1.19';
sub _raw_to_marc_record {
my ($self,$data) = @_;
- my $marc = MARC::Record->new();
+ my $marc = MARC::Record->new();
for my $field (@$data) {
my ($tag, $ind1, $ind2, @data) = @$field;
- if ($tag eq 'LDR') {
+ $ind1 //= ' ';
+ $ind2 //= ' ';
+
+ @data = $self->_clean_raw_data($tag, at data);
+
+ if (@data < 2) {
+ $self->log->warn("$tag doesn't have any data");
+ }
+ elsif ($tag eq 'LDR') {
$marc->leader($data[1]);
}
elsif ($tag =~ /^00/) {
@@ -33,7 +41,7 @@ sub _json_to_raw {
my @record = ();
push (@record , [ 'LDR', ' ', ' ', '_' , $data->{leader}] ) if defined $data->{leader};
-
+
for my $field (@{$data->{fields}}) {
my ($tag) = keys %$field;
my $val = $field->{$tag};
@@ -66,8 +74,7 @@ sub _clean_raw_data {
push(@result, $data[$i], $data[$i+1]);
}
}
-
@result;
}
-1;
\ No newline at end of file
+1;
diff --git a/lib/Catmandu/Fix/marc_copy.pm b/lib/Catmandu/Fix/marc_copy.pm
index a9c5c8a..7b8103e 100644
--- a/lib/Catmandu/Fix/marc_copy.pm
+++ b/lib/Catmandu/Fix/marc_copy.pm
@@ -145,6 +145,8 @@ Copy this MARC fields referred by a MARC_PATH to a JSON_PATH.
upcase(loop.v)
end
end
+
+ marc_paste(tmp)
end
end
diff --git a/lib/Catmandu/Fix/marc_cut.pm b/lib/Catmandu/Fix/marc_cut.pm
index 18a1334..e76d6d5 100644
--- a/lib/Catmandu/Fix/marc_cut.pm
+++ b/lib/Catmandu/Fix/marc_cut.pm
@@ -141,6 +141,8 @@ These JSON paths can be used like:
upcase(loop.v)
end
end
+
+ marc_paste(tmp)
end
end
diff --git a/t/Catmandu/Exporter/MARC/ISO.t b/t/Catmandu/Exporter/MARC/ISO.t
index 99573f7..550a36d 100644
--- a/t/Catmandu/Exporter/MARC/ISO.t
+++ b/t/Catmandu/Exporter/MARC/ISO.t
@@ -4,6 +4,7 @@ use strict;
use warnings;
use Test::More;
use Test::Exception;
+use Catmandu::Exporter::MARC;
my $pkg;
@@ -14,4 +15,31 @@ BEGIN {
require_ok $pkg;
+my $marciso = undef;
+
+my $exporter = Catmandu::Exporter::MARC->new(file => \$marciso, type=> 'ISO');
+
+ok $exporter , 'got an MARC/ISO exporter';
+
+ok $exporter->add({
+ _id => '1' ,
+ record => [
+ ['FMT', undef, undef, '_', 'BK'],
+ ['001', undef, undef, '_', 'rec001'],
+ ['100', ' ', ' ', 'a', 'Davis, Miles' , 'c' , 'Test'],
+ ['245', ' ', ' ',
+ 'a', 'Sketches in Blue' ,
+ ],
+ ['500', ' ', ' ', 'a', undef],
+ ['501', ' ', ' ' ],
+ ['502', ' ', ' ', 'a', undef, 'b' , 'ok'],
+ ['503', ' ', ' ', 'a', ''],
+ ['CAT', ' ', ' ', 'a', 'test'],
+ ]
+}) , 'add';
+
+ok $exporter->commit , 'commit';
+
+ok length($marciso) >= 127 , 'got iso';
+
done_testing;
diff --git a/t/Catmandu/Exporter/MARC/MARCMaker.t b/t/Catmandu/Exporter/MARC/MARCMaker.t
index 8ce07f7..29aaa0c 100644
--- a/t/Catmandu/Exporter/MARC/MARCMaker.t
+++ b/t/Catmandu/Exporter/MARC/MARCMaker.t
@@ -4,6 +4,7 @@ use strict;
use warnings;
use Test::More;
use Test::Exception;
+use Catmandu::Exporter::MARC;
my $pkg;
@@ -14,4 +15,29 @@ BEGIN {
require_ok $pkg;
+my $marcmaker = undef;
+
+my $exporter = Catmandu::Exporter::MARC->new(file => \$marcmaker, type=> 'MARCMaker');
+
+ok $exporter , 'got an MARC/MARCMaker exporter';
+
+ok $exporter->add({
+ _id => '1' ,
+ record => [
+ ['FMT', undef, undef, '_', 'BK'],
+ ['001', undef, undef, '_', 'rec001'],
+ ['100', ' ', ' ', 'a', 'Davis, Miles' , 'c' , 'Test'],
+ ['245', ' ', ' ',
+ 'a', 'Sketches in Blue' ,
+ ],
+ ['500', ' ', ' ', 'a', undef],
+ ['501', ' ', ' ' ],
+ ['502', ' ', ' ', 'a', undef, 'b' , 'ok'],
+ ['503', ' ', ' ', 'a', ''],
+ ['CAT', ' ', ' ', 'a', 'test'],
+ ]
+}) , 'add';
+
+ok $exporter->commit , 'commit';
+
done_testing;
--
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