[libcatmandu-marc-perl] 02/208: Fixed filter by indicator 2 in Catmandu::Fix::marc_map #28

[Jonas Smedegaard]

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 8e5473671d38ebbccaa1296f0b8a73260024ab2b
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Wed Jun 1 10:57:39 2016 +0200

    Fixed filter by indicator 2 in Catmandu::Fix::marc_map #28
---
 Changes                      |  3 +-
 lib/Catmandu/Fix/marc_add.pm |  2 ++
 lib/Catmandu/Fix/marc_map.pm |  9 +++--
 lib/Catmandu/MARC.pm         | 81 ++++++++++++++++++++++++++++++++++++++++----
 4 files changed, 85 insertions(+), 10 deletions(-)

diff --git a/Changes b/Changes
index 23bfebe..abcb674 100644
--- a/Changes
+++ b/Changes
@@ -1,7 +1,8 @@
 Revision history for Catmandu-MARC
 
 {{$NEXT}}
-
+  - Fixed indicator-2 selection bug
+  
 0.215  2016-02-22 09:57:07 CET
   - Supporting ISO alias for USMARC importer and exporter
   - Fixing MicroLIF importer
diff --git a/lib/Catmandu/Fix/marc_add.pm b/lib/Catmandu/Fix/marc_add.pm
index db83e3f..bbc36de 100644
--- a/lib/Catmandu/Fix/marc_add.pm
+++ b/lib/Catmandu/Fix/marc_add.pm
@@ -5,6 +5,8 @@ use Catmandu::Util qw(:is);
 use Moo;
 use Catmandu::Fix::Has;
 
+with 'Catmandu::Fix::Inlineable';
+
 our $VERSION = '0.215';
 
 has marc_tag    => (fix_arg => 1);
diff --git a/lib/Catmandu/Fix/marc_map.pm b/lib/Catmandu/Fix/marc_map.pm
index a621a98..fd36856 100644
--- a/lib/Catmandu/Fix/marc_map.pm
+++ b/lib/Catmandu/Fix/marc_map.pm
@@ -25,7 +25,7 @@ sub emit {
     my $field_regex;
     my ($field,$ind1,$ind2,$subfield_regex,$from,$to);
 
-    if ($marc_path =~ /(\S{3})(\[(.)?,?(.)?\])?([_a-z0-9^]+)?(\/(\d+)(-(\d+))?)?/) {
+    if ($marc_path =~ /(\S{3})(\[([^,])?,?([^,])?\])?([_a-z0-9^]+)?(\/(\d+)(-(\d+))?)?/) {
         $field          = $1;
         $ind1           = $3;
         $ind2           = $4;
@@ -44,7 +44,6 @@ sub emit {
     my $vals = $fixer->generate_var;
     my $perl = $fixer->emit_declare_vars($vals, '[]');
 
-
     $perl .= $fixer->emit_foreach("${var}->{${record_key}}", sub {
         my $var  = shift;
         my $v    = $fixer->generate_var;
@@ -187,6 +186,12 @@ Catmandu::Fix::marc_map - copy marc values of one field to a new field
     # Map the 100-a field where indicator-1 is 3
     marc_map('100[3]a','name.family')
 
+    # Map the 245-a field where indicator-2 is 0
+    marc_map('245[,0]a','title')
+
+    # Map the 245-a field where indicator-1 is 1 and indicator-2 is 0
+    marc_map('245[1,0]a','title')
+
 =head1 DESCRIPTION
 
 Read our Wiki pages at L<https://github.com/LibreCat/Catmandu/wiki/Fixes> for a complete
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index 01e3cf4..435531c 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -1,5 +1,79 @@
 package Catmandu::MARC;
 
+use Catmandu::Util;
+use Catmandu::Exporter::MARC::XML;
+
+our $VERSION = '0.215';
+
+sub marc_add {
+    my ($data,$marc_tag,$subfield_array) = @_;
+
+    my @subfields  = @{$subfield_array};
+    my %subfields  = @subfields;
+    my $record_key = $subfields{'-record'} // 'record';
+    my $marc       = $data->{$record_key} // [];
+
+    if ($marc_tag =~ /^\w{3}$/) {
+        my @field = ();
+        push @field , $marc_tag;
+        push @field , $subfields{ind1} // ' ';
+        push @field , $subfields{ind2} // ' ';
+
+
+        for (my $i = 0 ; $i < @subfields ; $i += 2) {
+            my $code  = $subfields[$i];
+            next unless length $code == 1;
+            my $value = $subfields[$i+1];
+
+            if ($value =~ /^\$\.(\S+)$/) {
+                my $path = $1;
+                $value = Catmandu::Util::data_at($path,$data);
+            }
+
+            if (Catmandu::Util::is_array_ref $value) {
+                for (@$value) {
+                    push @field , $code;
+                    push @field , $_;
+                }
+            }
+            elsif (Catmandu::Util::is_hash_ref $value) {
+                for (keys %$value) {
+                    push @field , $code;
+                    push @field , $value->{$_};
+                }
+            }
+            elsif (Catmandu::Util::is_value($value) && length($value) > 0) {
+                push @field , $code;
+                push @field , $value;
+            }
+        }
+
+        push @{ $marc } , \@field if @field > 3;
+    }
+
+    $data->{$record_key} = $marc;
+
+    $data;
+}
+
+sub marc_xml {
+    my ($data,$path) = @_;
+    $path //= 'record';
+
+    my $xml;
+    my $exporter = Catmandu::Exporter::MARC::XML->new(file => \$xml , xml_declaration => 0 , collection => 0);
+    $exporter->add($data);
+    $exporter->commit;
+
+    $data->{$path} = $xml;
+
+    $data;
+}
+
+1;
+
+__END__
+
 =head1 NAME
 
 Catmandu::MARC - Catmandu modules for working with MARC data
@@ -14,10 +88,6 @@ Catmandu::MARC - Catmandu modules for working with MARC data
 
 =end markdown
 
-=cut
-
-our $VERSION = '0.215';
-
 =head1 SYNOPSIS
 
  # On the command line
@@ -131,6 +201,3 @@ by the Free Software Foundation; or the Artistic License.
 See http://dev.perl.org/licenses/ for more information.
 
 =cut
-
-1;
-

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