[libcatmandu-marc-perl] 68/208: Fixing the marc_has_many bug

Jonas Smedegaard dr at jones.dk
Sat Oct 28 03:42:36 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 128105c05cba09ed49f16c8731e6530abba99bec
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Thu Nov 3 08:47:52 2016 +0100

    Fixing the marc_has_many bug
---
 Changes                                     |  4 +++-
 lib/Catmandu/Fix/Condition/marc_has_many.pm | 13 +++++++++++--
 lib/Catmandu/MARC/Tutorial.pod              | 27 +++++++++++++++++++++++++++
 t/20-marc_has.t                             |  4 ++++
 4 files changed, 45 insertions(+), 3 deletions(-)

diff --git a/Changes b/Changes
index 298a4de..f509b7d 100644
--- a/Changes
+++ b/Changes
@@ -1,10 +1,12 @@
 Revision history for Catmandu-MARC
 
 {{$NEXT}}
+  - Adding a Catmandu::MARC::Tutorial
+  - Fixing a bug in the marc_has_many
 
 1.02  2016-10-15 11:18:48 CEST
   - Fixing bug when accessing subfields 0 in MARC
-  
+
 1.01  2016-09-27 16:35:19 CEST
   - Bug version
 
diff --git a/lib/Catmandu/Fix/Condition/marc_has_many.pm b/lib/Catmandu/Fix/Condition/marc_has_many.pm
index 5116f6e..9d41111 100644
--- a/lib/Catmandu/Fix/Condition/marc_has_many.pm
+++ b/lib/Catmandu/Fix/Condition/marc_has_many.pm
@@ -19,10 +19,19 @@ sub emit {
     my $perl;
 
     my $tmp_var  = '_tmp_' . int(rand(9999));
-    my $marc_map = Catmandu::Fix::marc_map->new($self->marc_path , "$tmp_var.\$append", -split=>1);
+    my $marc_map = Catmandu::Fix::marc_map->new(
+                        $self->marc_path ,
+                        "$tmp_var" ,
+                        -split=>1 ,
+                        -nested_arrays=>1
+                    );
     $perl .= $marc_map->emit($fixer,$label);
 
-    my $all_match    = Catmandu::Fix::Condition::exists->new("$tmp_var.0.1");
+    my $all_match    =
+        $self->marc_path =~ m{^...(\/\d+-\d+)?$} ?
+            Catmandu::Fix::Condition::exists->new("$tmp_var.1") :
+            Catmandu::Fix::Condition::exists->new("$tmp_var.0.1");
+
     my $remove_field = Catmandu::Fix::remove_field->new($tmp_var);
 
     my $pass_fixes = $self->pass_fixes;
diff --git a/lib/Catmandu/MARC/Tutorial.pod b/lib/Catmandu/MARC/Tutorial.pod
index 4c0cf75..c9768b3 100644
--- a/lib/Catmandu/MARC/Tutorial.pod
+++ b/lib/Catmandu/MARC/Tutorial.pod
@@ -197,6 +197,33 @@ Run this Fix script (without the line number) using this command
 
     $ catmandu convert MARC to CSV --fix myfix.fix < data.mrc
 
+=head2 Create a MARC validator
+
+For this example we need a Fix script that contains validation rules we need to
+check. For instance, we require to have a 245 field and at least a 008 control
+field with a date filled in. This can be coded as in:
+
+    # Check if a 245 field is present
+    unless marc_has('245')
+      log("no 245 field",level:ERROR)
+    end
+
+    # Check if there is more than one 245 field
+    if marc_has_many('245')
+      log("more than one 245 field?",level:ERROR)
+    end
+
+    # Check if in 008 position 7 to 10 contains a 4 digit number ('\d' means digit)
+    unless marc_match('008/07-10','\d{4}')
+      log("no 4-digit year in 008 position 7 -> 10",level:ERROR)
+    end
+
+Put this Fix script in a file C<myfix.fix> and execute the Catmandu command
+with the "-D" option for logging and the Null exporter to discard the normal
+output
+
+    $ catmandu -D convert MARC to Null --fix myfix.fix < data.mrc
+
 =head1 WRITING
 
 =head2 Convert a MARC record into a MARC record (do nothing)
diff --git a/t/20-marc_has.t b/t/20-marc_has.t
index a3416c5..76f3785 100644
--- a/t/20-marc_has.t
+++ b/t/20-marc_has.t
@@ -16,6 +16,10 @@ if marc_has(245)
   add_field(test.\$append,'has 245')
 end
 
+if marc_has_many(245)
+  add_field(test.\$append,'has many 245')
+end
+
 if marc_has_many(CAT)
   add_field(test.\$append,'has many CAT')
 end

-- 
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