[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