[libcatmandu-marc-perl] 35/208: Deleting the 'record' option for all fixes
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:32 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 c1328bbb341fc25bc84f614d8ea523337d9a026a
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Wed Jul 13 11:22:33 2016 +0200
Deleting the 'record' option for all fixes
---
lib/Catmandu/Fix/marc_decode_dollar_subfields.pm | 5 +-
lib/Catmandu/Fix/marc_in_json.pm | 13 +----
lib/Catmandu/Fix/marc_map.pm | 26 ++++------
lib/Catmandu/Fix/marc_remove.pm | 12 +----
lib/Catmandu/Fix/marc_set.pm | 10 +---
lib/Catmandu/MARC.pm | 66 +++++++++++-------------
6 files changed, 44 insertions(+), 88 deletions(-)
diff --git a/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm b/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm
index 290fca1..d85e3ff 100644
--- a/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm
+++ b/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm
@@ -9,12 +9,9 @@ with 'Catmandu::Fix::Inlineable';
our $VERSION = '0.219';
-has record => (fix_opt => 1);
-
sub fix {
my ($self,$data) = @_;
- my $record_key = $self->record // 'record';
- return Catmandu::MARC->instance->marc_decode_dollar_subfields($data, record => $record_key);
+ return Catmandu::MARC->instance->marc_decode_dollar_subfields($data);
}
=head1 NAME
diff --git a/lib/Catmandu/Fix/marc_in_json.pm b/lib/Catmandu/Fix/marc_in_json.pm
index 2b8701a..239b7e0 100644
--- a/lib/Catmandu/Fix/marc_in_json.pm
+++ b/lib/Catmandu/Fix/marc_in_json.pm
@@ -9,7 +9,6 @@ with 'Catmandu::Fix::Inlineable';
our $VERSION = '0.219';
-has record => (fix_opt => 1);
has reverse => (fix_opt => 1);
# Transform a raw MARC array into MARC-in-JSON
@@ -17,13 +16,12 @@ has reverse => (fix_opt => 1);
# http://dilettantes.code4lib.org/blog/2010/09/a-proposal-to-serialize-marc-in-json/
sub fix {
my ($self, $data) = @_;
- my $record_key = $self->record // 'record';
if ($self->reverse) {
- return Catmandu::MARC->instance->marc_json_to_record($data, record => $record_key);
+ return Catmandu::MARC->instance->marc_json_to_record($data);
}
else {
- return Catmandu::MARC->instance->marc_record_to_json($data, record => $record_key);
+ return Catmandu::MARC->instance->marc_record_to_json($data);
}
}
@@ -36,9 +34,6 @@ Catmandu::Fix::marc_in_json - transform a Catmandu MARC record into MARC-in-JSON
# Transform a Catmandu MARC 'record' into a MARC-in-JSON record
marc_in_json()
- # Optionally provide a pointer to the marc record
- marc_in_json(record:record)
-
# Reverse, transform a MARC-in-JSON record into a Catmandu MARC record
marc_in_json(reverse:1)
@@ -58,10 +53,6 @@ Convert a Catmandu MARC record into the MARC-in-JSON format.
Convert a MARC-in-JSON record back into the Catmandu MARC format.
-=head2 record: STR
-
-Specify the JSON_PATH where the MARC record can be found (default: record).
-
=head1 INLINE
This Fix can be used inline in a Perl script:
diff --git a/lib/Catmandu/Fix/marc_map.pm b/lib/Catmandu/Fix/marc_map.pm
index 295f96c..d425362 100644
--- a/lib/Catmandu/Fix/marc_map.pm
+++ b/lib/Catmandu/Fix/marc_map.pm
@@ -11,7 +11,6 @@ our $VERSION = '0.219';
has marc_path => (fix_arg => 1);
has path => (fix_arg => 1);
-has record => (fix_opt => 1);
has split => (fix_opt => 1);
has join => (fix_opt => 1);
has value => (fix_opt => 1);
@@ -20,20 +19,22 @@ has nested_arrays => (fix_opt => 1);
sub emit {
my ($self,$fixer) = @_;
- my $path = $fixer->split_path($self->path);
-
- my $marc = $fixer->capture(Catmandu::MARC->instance);
- my $marc_path = $fixer->emit_string($self->marc_path);
- my $marc_opt = $fixer->capture({
- '-record' => $self->record // 'record' ,
+ my $path = $fixer->split_path($self->path);
+ my $marc_obj = Catmandu::MARC->instance;
+
+ # Precompile the marc_path to gain some speed
+ my $marc_context = $marc_obj->compile_marc_path($self->marc_path,subfield_wildcard => 1);
+ my $marc = $fixer->capture($marc_obj);
+ my $marc_path = $fixer->capture($marc_context);
+ my $marc_opt = $fixer->capture({
'-join' => $self->join // '' ,
'-split' => $self->split // 0 ,
'-pluck' => $self->pluck // 0 ,
'-nested_arrays' => $self->nested_arrays // 0 ,
'-value' => $self->value
});
- my $var = $fixer->var;
- my $result = $fixer->generate_var;
+ my $var = $fixer->var;
+ my $result = $fixer->generate_var;
my $perl =<<EOF;
if (my ${result} = ${marc}->marc_map(
@@ -97,9 +98,6 @@ Catmandu::Fix::marc_map - copy marc values of one field to a new field
# When 260c field exists create the my.has260c hash with value 'found'
marc_map('260c','my.has260c', value:found)
- # Do the same examples now with the marc fields in 'record2'
- marc_map('245','my.title', record:record2)
-
# Copy all 100 subfields except the digits to the 'author' field
marc_map('100^0123456789','author')
@@ -204,10 +202,6 @@ array of strings (one string for each subfield found). Using the nested_array
option the output will be an array of array of strings (one array item for
each matched field, one array of strings for each matched subfield).
-=head2 record: STR
-
-Specify the JSON_PATH where the MARC record can be found (default: record).
-
=head1 INLINE
This Fix can be used inline in a Perl script:
diff --git a/lib/Catmandu/Fix/marc_remove.pm b/lib/Catmandu/Fix/marc_remove.pm
index 633ef43..2411be7 100644
--- a/lib/Catmandu/Fix/marc_remove.pm
+++ b/lib/Catmandu/Fix/marc_remove.pm
@@ -10,13 +10,11 @@ with 'Catmandu::Fix::Inlineable';
our $VERSION = '0.219';
has marc_path => (fix_arg => 1);
-has record => (fix_opt => 1);
sub fix {
my ($self,$data) = @_;
my $marc_path = $self->marc_path;
- my $record_key = $self->record // 'record';
- return Catmandu::MARC->instance->marc_remove($data, $marc_path, record => $record_key);
+ return Catmandu::MARC->instance->marc_remove($data, $marc_path);
}
=head1 NAME
@@ -31,8 +29,6 @@ Catmandu::Fix::marc_remove - remove marc (sub)fields
# remove the 245-a subfield
marc_remove('245a')
- # the same with the marc fields in 'record2'
- marc_remove('600', record:record2)
=head1 DESCRIPTION
@@ -44,12 +40,6 @@ Remove (sub)fields in a MARC record
Delete the (sub)fields from the MARC record as indicated by the MARC_PATH.
-=head1 OPTIONS
-
-=head2 record: STR
-
-Specify the JSON_PATH where the MARC record can be found (default: record).
-
=head1 INLINE
This Fix can be used inline in a Perl script:
diff --git a/lib/Catmandu/Fix/marc_set.pm b/lib/Catmandu/Fix/marc_set.pm
index 7eb30cc..be0ccd5 100644
--- a/lib/Catmandu/Fix/marc_set.pm
+++ b/lib/Catmandu/Fix/marc_set.pm
@@ -11,14 +11,12 @@ our $VERSION = '0.219';
has marc_path => (fix_arg => 1);
has value => (fix_arg => 1);
-has record => (fix_opt => 1);
sub fix {
my ($self,$data) = @_;
my $marc_path = $self->marc_path;
my $value = $self->value;
- my $record_key = $self->record;
- return Catmandu::MARC->instance->marc_set($data,$marc_path,$value, record => $record_key);
+ return Catmandu::MARC->instance->marc_set($data,$marc_path,$value);
}
=head1 NAME
@@ -52,12 +50,6 @@ Set the value of a MARC subfield to a new value.
Set a MARC subfield to a particular new value. This valeu can be a literal or
reference an existing field in the record using the dollar JSON_PATH syntax.
-=head1 OPTIONS
-
-=head2 record: STR
-
-Specify the JSON_PATH where the MARC record can be found (default: record).
-
=head1 INLINE
This Fix can be used inline in a Perl script:
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index ab2af8a..d74ae2d 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -8,7 +8,7 @@ use Carp;
use Moo;
with 'MooX::Singleton';
-memoize('_compile_marc_path');
+memoize('compile_marc_path');
our $VERSION = '0.219';
@@ -18,29 +18,30 @@ sub marc_map {
my $marc_path = $_[2];
my $opts = $_[3];
- my $record_key = $opts->{'-record'} // 'record';
+ my $context = ref($marc_path) ?
+ $marc_path :
+ $self->compile_marc_path($marc_path, subfield_wildcard => 1);
- return wantarray ? () : undef
- unless (defined $data->{$record_key} && ref $data->{$record_key} eq 'ARRAY');
+ confess "invalid marc path" unless $context;
+
+ my $record = $data->{'record'};
+
+ return wantarray ? () : undef unless (defined $record && ref($record) eq 'ARRAY');
my $split = $opts->{'-split'} // 0;
- my $join_char = $opts->{'-join'} // '';
+ my $join_char = $opts->{'-join'} // '';
my $pluck = $opts->{'-pluck'} // 0;
my $value_set = $opts->{'-value'};
my $nested_arrays = $opts->{'-nested_arrays'} // 0;
- my $context = _compile_marc_path($marc_path, subfield_wildcard => 1);
-
- confess "invalid marc path" unless $context;
-
my $vals;
- for my $field (@{$data->{$record_key}}) {
+ for my $field (@$record) {
next if (
- ($context->{is_regex_field} == 1 && $field->[0] !~ $context->{field_regex} )
- ||
($context->{is_regex_field} == 0 && $field->[0] ne $context->{field} )
||
+ ($context->{is_regex_field} == 1 && $field->[0] !~ $context->{field_regex} )
+ ||
(defined $context->{ind1} && (!defined $field->[1] || $field->[1] ne $context->{ind1}))
||
(defined $context->{ind2} && (!defined $field->[2] || $field->[2] ne $context->{ind2}))
@@ -135,14 +136,11 @@ sub marc_map {
}
}
- if (!defined $vals) {
- return undef;
- }
- elsif (wantarray) {
- return defined($vals) && ref($vals) eq 'ARRAY' ? @$vals : ($vals);
+ if (wantarray) {
+ defined($vals) && ref($vals) eq 'ARRAY' ? @$vals : ($vals);
}
else {
- return $vals;
+ $vals;
}
}
@@ -150,8 +148,7 @@ sub marc_add {
my ($self,$data,$marc_path, at subfields) = @_;
my %subfields = @subfields;
- my $record_key = $subfields{'-record'} // 'record';
- my $marc = $data->{$record_key} // [];
+ my $marc = $data->{'record'} // [];
if ($marc_path =~ /^\w{3}$/) {
my @field = ();
@@ -191,15 +188,14 @@ sub marc_add {
push @{ $marc } , \@field if @field > 3;
}
- $data->{$record_key} = $marc;
+ $data->{'record'} = $marc;
$data;
}
sub marc_set {
my ($self,$data,$marc_path,$value,%opts) = @_;
- my $record_key = $opts{record} // 'record';
- my $record = $data->{$record_key};
+ my $record = $data->{'record'};
return $data unless defined $record;
@@ -219,7 +215,7 @@ sub marc_set {
$value = $last;
}
- my $context = _compile_marc_path($marc_path, subfield_default => 1);
+ my $context = $self->compile_marc_path($marc_path, subfield_default => 1);
confess "invalid marc path" unless $context;
@@ -267,12 +263,11 @@ sub marc_set {
sub marc_remove {
my ($self,$data, $marc_path,%opts) = @_;
- my $record_key = $opts{record} // 'record';
- my $record = $data->{$record_key};
+ my $record = $data->{'record'};
my $new_record;
- my $context = _compile_marc_path($marc_path);
+ my $context = $self->compile_marc_path($marc_path);
confess "invalid marc path" unless $context;
@@ -315,7 +310,7 @@ sub marc_remove {
push @$new_record , $field;
}
- $data->{$record_key} = $new_record;
+ $data->{'record'} = $new_record;
return $data;
}
@@ -333,9 +328,8 @@ sub marc_xml {
sub marc_record_to_json {
my ($self,$data,%opts) = @_;
- my $record_key = $opts{record} // 'record';
- if (my $marc = delete $data->{$record_key}) {
+ if (my $marc = delete $data->{'record'}) {
for my $field (@$marc) {
my ($tag, $ind1, $ind2, @subfields) = @$field;
@@ -366,7 +360,6 @@ sub marc_record_to_json {
sub marc_json_to_record {
my ($self,$data,%opts) = @_;
- my $record_key = $opts{record} // 'record';
my $record = [];
@@ -407,7 +400,7 @@ sub marc_json_to_record {
if (@$record > 0) {
delete $data->{fields};
delete $data->{leader};
- $data->{$record_key} = $record;
+ $data->{'record'} = $record;
}
$data;
@@ -415,8 +408,7 @@ sub marc_json_to_record {
sub marc_decode_dollar_subfields {
my ($self,$data,%opts) = @_;
- my $record_key = $opts{record} // 'record';
- my $old_record = $data->{$record_key};
+ my $old_record = $data->{'record'};
my $new_record = [];
for my $field (@$old_record) {
@@ -444,13 +436,13 @@ sub marc_decode_dollar_subfields {
push @$new_record , $fixed_field;
}
- $data->{$record_key} = $new_record;
+ $data->{'record'} = $new_record;
$data;
}
-sub _compile_marc_path {
- my ($marc_path,%opts) = @_;
+sub compile_marc_path {
+ my ($self,$marc_path,%opts) = @_;
my ($field,$field_regex,$ind1,$ind2,
$subfield,$subfield_regex,$from,$to,$len,$is_regex_field);
--
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