[libcatmandu-marc-perl] 185/208: Fixing marc_set("FMT", ...) does not work correctly #79

Jonas Smedegaard dr at jones.dk
Sat Oct 28 03:42:49 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 48f0f99b66914f44ec4171dbf09508c11f74a942
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Wed Jul 12 11:23:03 2017 +0200

    Fixing marc_set("FMT", ...) does not work correctly #79
---
 Changes                         |  1 +
 README.md                       |  1 +
 lib/Catmandu/Exporter/MARC.pm   | 37 +++++++++++++++++++++++--------------
 lib/Catmandu/Fix/marc_add.pm    | 10 ++++++++--
 lib/Catmandu/Fix/marc_copy.pm   |  2 ++
 lib/Catmandu/Fix/marc_paste.pm  |  4 +++-
 lib/Catmandu/Fix/marc_remove.pm |  6 +++++-
 lib/Catmandu/Fix/marc_set.pm    |  8 +++++++-
 lib/Catmandu/Importer/MARC.pm   |  5 ++---
 lib/Catmandu/MARC.pm            |  6 ++++--
 10 files changed, 56 insertions(+), 24 deletions(-)

diff --git a/Changes b/Changes
index 9e19097..3c8ae4f 100644
--- a/Changes
+++ b/Changes
@@ -3,6 +3,7 @@ Revision history for Catmandu-MARC
 {{$NEXT}}
   - Fixing 0 as false bug when using from/until
   - Fixing double fix execution bug
+  - Using better subfield defaults for marc_set
 
 1.161  2017-07-06 14:36:29 CEST
   - Fixing marc_replace_all evaluating search groups
diff --git a/README.md b/README.md
index 22afeb9..47d065c 100644
--- a/README.md
+++ b/README.md
@@ -57,6 +57,7 @@ Catmandu::MARC - Catmandu modules for working with MARC data
 - [Catmandu::Fix::marc\_decode\_dollar\_subfields](https://metacpan.org/pod/Catmandu::Fix::marc_decode_dollar_subfields)
 - [Catmandu::Fix::marc\_set](https://metacpan.org/pod/Catmandu::Fix::marc_set)
 - [Catmandu::Fix::marc\_copy](https://metacpan.org/pod/Catmandu::Fix::marc_copy)
+- [Catmandu::Fix::marc\_cut](https://metacpan.org/pod/Catmandu::Fix::marc_cut)
 - [Catmandu::Fix::marc\_paste](https://metacpan.org/pod/Catmandu::Fix::marc_paste)
 - [Catmandu::Fix::Bind::marc\_each](https://metacpan.org/pod/Catmandu::Fix::Bind::marc_each)
 - [Catmandu::Fix::Condition::marc\_match](https://metacpan.org/pod/Catmandu::Fix::Condition::marc_match)
diff --git a/lib/Catmandu/Exporter/MARC.pm b/lib/Catmandu/Exporter/MARC.pm
index 83946de..f653520 100644
--- a/lib/Catmandu/Exporter/MARC.pm
+++ b/lib/Catmandu/Exporter/MARC.pm
@@ -1,36 +1,45 @@
 package Catmandu::Exporter::MARC;
 use Catmandu::Sane;
+use Catmandu::Util;
 use Moo;
 
 our $VERSION = '1.161';
 
 has type           => (is => 'ro' , default => sub { 'ISO' });
-has _exporter      => (is => 'ro' , lazy => 1 , builder => '_build_exporter' , handles => 'Catmandu::Exporter');
-has _exporter_args => (is => 'rwp', writer => '_set_exporter_args');
+has _exporter      => (is => 'ro');
 
-sub _build_exporter {
-    my ($self) = @_;
-
-    my $type = $self->type;
-
-    my $pkg = Catmandu::Util::require_package($type,'Catmandu::Exporter::MARC');
-
-    $pkg->new($self->_exporter_args);
-}
+with 'Catmandu::Exporter';
 
 sub BUILD {
     my ($self,$args) = @_;
-    $self->_set_exporter_args($args);
+
+    my $type = $self->type;
 
     # keep USMARC temporary as alias for ISO, remove in future version
     # print deprecation warning
-    if ($self->{type} eq 'USMARC') {
-        $self->{type} = 'ISO';
+    if ($type eq 'USMARC') {
+        $type = 'ISO';
         warn( "deprecated", "Oops! Exporter \"USMARC\" is deprecated. Use \"ISO\" instead." );
     }
+
+    my $pkg = Catmandu::Util::require_package($type,'Catmandu::Exporter::MARC');
+
+    delete $args->{file};
+    delete $args->{fix};
+
+    $self->{_exporter} = $pkg->new(file => $self->file, %$args);
+}
+
+sub add {
+    $_[0]->_exporter->add($_[1]);
+}
+
+sub commit {
+    $_[0]->_exporter->commit;
 }
 
 1;
+
 __END__
 
 =head1 NAME
diff --git a/lib/Catmandu/Fix/marc_add.pm b/lib/Catmandu/Fix/marc_add.pm
index c0d5d27..7cb9670 100644
--- a/lib/Catmandu/Fix/marc_add.pm
+++ b/lib/Catmandu/Fix/marc_add.pm
@@ -29,7 +29,10 @@ Catmandu::Fix::marc_add - add new fields to marc
     # Set literal values
     marc_add('900', a, 'test' , 'b', test)
     marc_add('900', ind1 , ' ' , a, 'test' , 'b', test)
-    marc_add('900', ind1 , ' ' , a, 'test' , 'b', test , record:record2)
+    marc_add('900', ind1 , ' ' , a, 'test' , 'b', test)
+
+    # Set control fields
+    marc_add('009','_','23123131')
 
     # Copy data from an other field (when the field value is an array, the
     # subfield will be repeated)
@@ -61,7 +64,10 @@ This Fix can be used inline in a Perl script:
 
 =head1 SEE ALSO
 
-L<Catmandu::Fix>
+L<Catmandu::Fix::marc_set>,
+L<Catmandu::Fix::marc_copy>,
+L<Catmandu::Fix::marc_cut>,
+L<Catmandu::Fix::marc_paste>
 
 =cut
 
diff --git a/lib/Catmandu/Fix/marc_copy.pm b/lib/Catmandu/Fix/marc_copy.pm
index c2f2277..9efe1a1 100644
--- a/lib/Catmandu/Fix/marc_copy.pm
+++ b/lib/Catmandu/Fix/marc_copy.pm
@@ -162,6 +162,8 @@ This Fix can be used inline in a Perl script:
 
 =over
 
+=item * L<Catmandu::Fix::marc_cut>
+
 =item * L<Catmandu::Fix::marc_paste>
 
 =back
diff --git a/lib/Catmandu/Fix/marc_paste.pm b/lib/Catmandu/Fix/marc_paste.pm
index 9c7c9e5..a19a7c6 100644
--- a/lib/Catmandu/Fix/marc_paste.pm
+++ b/lib/Catmandu/Fix/marc_paste.pm
@@ -90,7 +90,9 @@ This Fix can be used inline in a Perl script:
 
 =over
 
-=item * L<Catmandu::Fix::marc_struc>
+=item * L<Catmandu::Fix::marc_copy>
+
+=item * L<Catmandu::Fix::marc_cut>
 
 =back
 
diff --git a/lib/Catmandu/Fix/marc_remove.pm b/lib/Catmandu/Fix/marc_remove.pm
index d2a81eb..91efca3 100644
--- a/lib/Catmandu/Fix/marc_remove.pm
+++ b/lib/Catmandu/Fix/marc_remove.pm
@@ -52,7 +52,11 @@ This Fix can be used inline in a Perl script:
 
 =head1 SEE ALSO
 
-L<Catmandu::Fix>
+L<Catmandu::Fix::marc_add>,
+L<Catmandu::Fix::marc_copy>,
+L<Catmandu::Fix::marc_cut>,
+L<Catmandu::Fix::marc_paste>,
+L<Catmandu::Fix::marc_set>
 
 =cut
 
diff --git a/lib/Catmandu/Fix/marc_set.pm b/lib/Catmandu/Fix/marc_set.pm
index 57a3cd9..b31c3fe 100644
--- a/lib/Catmandu/Fix/marc_set.pm
+++ b/lib/Catmandu/Fix/marc_set.pm
@@ -30,6 +30,9 @@ Catmandu::Fix::marc_set - set a marc value of one (sub)field to a new value
         marc_set('LDR/6','p')
     end
 
+    # Set a control field
+    marc_set('001',1234)
+
     # Set all the 650-p fields to 'test'
     marc_set('650p','test')
 
@@ -62,7 +65,10 @@ This Fix can be used inline in a Perl script:
 
 =head1 SEE ALSO
 
-L<Catmandu::Fix>
+L<Catmandu::Fix::marc_add>,
+L<Catmandu::Fix::marc_copy>,
+L<Catmandu::Fix::marc_cut>,
+L<Catmandu::Fix::marc_paste>
 
 =cut
 
diff --git a/lib/Catmandu/Importer/MARC.pm b/lib/Catmandu/Importer/MARC.pm
index 688f6aa..0ac0a87 100644
--- a/lib/Catmandu/Importer/MARC.pm
+++ b/lib/Catmandu/Importer/MARC.pm
@@ -32,12 +32,11 @@ sub BUILD {
     delete $args->{type};
     delete $args->{fix};
 
-    $self->{_importer} = $pkg->new(file => $self->file , type => $type, %$args);
+    $self->{_importer} = $pkg->new(file => $self->file, %$args);
 }
 
 sub generator {
-    my ($self) = @_;
-    $self->_importer->generator;
+    $_[0]->_importer->generator;
 }
 
 1;
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index 170d7c1..bb51fef 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -349,7 +349,7 @@ sub marc_set {
         $value = $last;
     }
 
-    my $context = $self->compile_marc_path($marc_path, subfield_wildcard => 1);
+    my $context = $self->compile_marc_path($marc_path, subfield_default => 1);
 
     confess "invalid marc path" unless $context;
 
@@ -997,7 +997,7 @@ sub compile_marc_path {
             }
         }
         elsif ($opts{subfield_default}) {
-            $subfield = $field =~ /^0|LDR/ ? '_' : 'a';
+            $subfield = $field =~ /^0|LDR|FMT/ ? '_' : 'a';
         }
         elsif ($opts{subfield_wildcard}) {
             $subfield = '[a-z0-9_]';
@@ -1368,6 +1368,8 @@ Catmandu::MARC - Catmandu modules for working with MARC data
 
 =item * L<Catmandu::Fix::marc_copy>
 
+=item * L<Catmandu::Fix::marc_cut>
+
 =item * L<Catmandu::Fix::marc_paste>
 
 =item * L<Catmandu::Fix::Bind::marc_each>

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