[libcatmandu-marc-perl] 16/208: Make all Catmandu::Fix inlinable #27
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:30 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 200a02dff37a7207c8ce0698d5afa39a1d63f702
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Thu Jun 23 14:17:07 2016 +0200
Make all Catmandu::Fix inlinable #27
---
lib/Catmandu/Fix/Inline/marc_add.pm | 8 +--
lib/Catmandu/Fix/marc_decode_dollar_subfields.pm | 4 +-
lib/Catmandu/Fix/marc_in_json.pm | 4 +-
lib/Catmandu/Fix/marc_map.pm | 22 +++---
lib/Catmandu/Fix/marc_remove.pm | 14 ++--
lib/Catmandu/Fix/marc_set.pm | 10 +--
lib/Catmandu/Fix/marc_xml.pm | 4 +-
t/18-inlineable.t | 87 ++++++++++++++++++++++++
8 files changed, 126 insertions(+), 27 deletions(-)
diff --git a/lib/Catmandu/Fix/Inline/marc_add.pm b/lib/Catmandu/Fix/Inline/marc_add.pm
index 3250741..73103f4 100644
--- a/lib/Catmandu/Fix/Inline/marc_add.pm
+++ b/lib/Catmandu/Fix/Inline/marc_add.pm
@@ -72,10 +72,10 @@ Catmandu::Fix::Inline::marc_add- A marc_add-er for Perl scripts
=head1 SEE ALSO
-L<Catmandu::Fix::Inline::marc_set> ,
-L<Catmandu::Fix::Inline::marc_map> ,
-L<Catmandu::Fix::Inline::marc_remove>
+L<Catmandu::Fix::Inline::marc_set> ,
+L<Catmandu::Fix::Inline::marc_map> ,
+L<Catmandu::Fix::Inline::marc_remove>
=cut
-1;
\ No newline at end of file
+1;
diff --git a/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm b/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm
index fb9afb1..794f6c4 100644
--- a/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm
+++ b/lib/Catmandu/Fix/marc_decode_dollar_subfields.pm
@@ -3,6 +3,8 @@ package Catmandu::Fix::marc_decode_dollar_subfields;
use Moo;
use Data::Dumper;
+with 'Catmandu::Fix::Inlineable';
+
our $VERSION = '0.218';
sub fix {
@@ -70,4 +72,4 @@ L<Catmandu::Fix>
=cut
-1;
\ No newline at end of file
+1;
diff --git a/lib/Catmandu/Fix/marc_in_json.pm b/lib/Catmandu/Fix/marc_in_json.pm
index 851c1d8..8415b90 100644
--- a/lib/Catmandu/Fix/marc_in_json.pm
+++ b/lib/Catmandu/Fix/marc_in_json.pm
@@ -5,6 +5,8 @@ use Catmandu::Util qw(:is);
use Moo;
use Catmandu::Fix::Has;
+with 'Catmandu::Fix::Inlineable';
+
our $VERSION = '0.218';
has record => (fix_opt => 1);
@@ -34,7 +36,7 @@ sub _json_record {
next unless is_hash_ref($field);
my ($tag) = keys %$field;
- my $val = $field->{$tag};
+ my $val = $field->{$tag};
if ($tag eq 'FMT' || substr($tag, 0, 2) eq '00') {
push @$record , [ $tag, undef, undef, '_', $val ],
diff --git a/lib/Catmandu/Fix/marc_map.pm b/lib/Catmandu/Fix/marc_map.pm
index 2b4c533..e7c30dc 100644
--- a/lib/Catmandu/Fix/marc_map.pm
+++ b/lib/Catmandu/Fix/marc_map.pm
@@ -5,6 +5,8 @@ use Carp qw(confess);
use Moo;
use Catmandu::Fix::Has;
+with 'Catmandu::Fix::Base';
+
our $VERSION = '0.218';
has marc_path => (fix_arg => 1);
@@ -63,7 +65,7 @@ sub emit {
$perl .= $fixer->emit_create_path($fixer->var, $path, sub {
my $var2 = shift;
my $i = $fixer->generate_var;
- return
+ return
"for (my ${i} = 3; ${i} < \@{${var}}; ${i} += 2) {".
"if (${var}->[${i}] =~ /${subfield_regex}/) {".
"${var2} = ${v}; last;".
@@ -77,7 +79,7 @@ sub emit {
if ($self->pluck) {
# Treat the subfield_regex as a hash index
my $pluck = $fixer->generate_var;
- return
+ return
"my ${pluck} = {};" .
"for (my ${i} = ${start}; ${i} < \@{${var}}; ${i} += 2) {".
"push(\@{ ${pluck}->{ ${var}->[${i}] } }, ${var}->[${i} + 1]);" .
@@ -88,7 +90,7 @@ sub emit {
}
else {
# Treat the subfield_regex as regex that needs to match the subfields
- return
+ return
"for (my ${i} = ${start}; ${i} < \@{${var}}; ${i} += 2) {".
"if (${var}->[${i}] =~ /${subfield_regex}/) {".
"push(\@{${v}}, ${var}->[${i} + 1]);".
@@ -122,13 +124,13 @@ sub emit {
" ${v} = undef;".
"}";
}
-
+
$perl .= $fixer->emit_create_path($fixer->var, $path, sub {
my $var = shift;
my $perl = "";
$perl .= "if (defined ${v}) {";
if ($self->split) {
- $perl .=
+ $perl .=
"${v} = [ ${v} ] unless ref ${v} eq 'ARRAY';" .
"if (is_array_ref(${var})) {".
"push \@{${var}}, \@{${v}};".
@@ -136,7 +138,7 @@ sub emit {
"${var} = [\@{${v}}];".
"}";
} else {
- $perl .=
+ $perl .=
"if (is_string(${var})) {".
"${var} = join(${join_char}, ${var}, ${v});".
"} else {".
@@ -146,7 +148,7 @@ sub emit {
$perl .= "}";
$perl;
});
-
+
$perl .= "}";
}
$perl;
@@ -163,8 +165,8 @@ Catmandu::Fix::marc_map - copy marc values of one field to a new field
=head1 SYNOPSIS
- # Append all 245 subfields to my.title field the values are joined into one string
- marc_map('245','my.title')
+ # Append all 245 subfields to my.title field the values are joined into one string
+ marc_map('245','my.title')
# Append al 245 subfields to the my.title keeping all subfields as an array
marc_map('245','my.title', split:1)
@@ -183,7 +185,7 @@ Catmandu::Fix::marc_map - copy marc values of one field to a new field
# Copy the 600-$x subfields into the my.subjects array while packing each into a genre.text hash
marc_map('600x','my.subjects.$append.genre.text')
-
+
# Copy the 008 characters 35-35 into the my.language hash
marc_map('008/35-35','my.language')
diff --git a/lib/Catmandu/Fix/marc_remove.pm b/lib/Catmandu/Fix/marc_remove.pm
index 918ada8..1f2c14d 100644
--- a/lib/Catmandu/Fix/marc_remove.pm
+++ b/lib/Catmandu/Fix/marc_remove.pm
@@ -5,6 +5,8 @@ use Carp qw(confess);
use Moo;
use Catmandu::Fix::Has;
+with 'Catmandu::Fix::Base';
+
our $VERSION = '0.218';
has marc_path => (fix_arg => 1);
@@ -49,7 +51,7 @@ sub emit {
if (defined $ind2) {
$perl .= "next if (defined ${var}->[2] && ${var}->[2] eq '${ind2}');";
- }
+ }
unless (defined $ind1 || defined $ind2 || defined $subfield_regex) {
$perl .= "next;";
@@ -58,7 +60,7 @@ sub emit {
$perl .= "}";
my $i = $fixer->generate_var;
-
+
my $new_subf = $fixer->generate_var;
$perl .= $fixer->emit_declare_vars($new_subf,'[]');
@@ -68,8 +70,8 @@ sub emit {
${new_subf} = [];
for (my ${i} = ${start}; ${i} < \@{${var}}; ${i} += 2) {
unless (${var}->[${i}] =~ /${subfield_regex}/) {
- push \@{${new_subf}} , ${var}->[${i}];
- push \@{${new_subf}} , ${var}->[${i}+1];
+ push \@{${new_subf}} , ${var}->[${i}];
+ push \@{${new_subf}} , ${var}->[${i}+1];
}
}
splice \@{${var}} , ${start} , int(\@{${var}}), \@{${new_subf}};
@@ -88,12 +90,12 @@ EOF
$perl .= "} elsif (defined ${var}->[5] && ${var}->[5] eq '_') {";
$perl .= $del_subfields->(5);
$perl .= "} else {";
-
+
$perl .= $del_subfields->(3);
$perl .= "}";
$perl .= "}";
}
-
+
$perl .= "push \@${new_record} , ${var} ";
$perl;
diff --git a/lib/Catmandu/Fix/marc_set.pm b/lib/Catmandu/Fix/marc_set.pm
index 0486caf..09f5bea 100644
--- a/lib/Catmandu/Fix/marc_set.pm
+++ b/lib/Catmandu/Fix/marc_set.pm
@@ -6,6 +6,8 @@ use Carp qw(confess);
use Moo;
use Catmandu::Fix::Has;
+with 'Catmandu::Fix::Base';
+
our $VERSION = '0.218';
has marc_path => (fix_arg => 1);
@@ -92,8 +94,8 @@ sub emit {
}
else {
$perl .= "${var}->[${i}+1] = ${value};";
- }
-
+ }
+
$perl .= "${found} = 1;";
$perl .= "}".
"}";
@@ -112,7 +114,7 @@ sub emit {
$perl .= "} elsif (defined ${var}->[5] && ${var}->[5] eq '_') {";
$perl .= $set_subfields->(5);
$perl .= "} else {";
-
+
$perl .= $set_subfields->(3);
$perl .= "}";
@@ -153,4 +155,4 @@ L<Catmandu::Fix>
=cut
-1;
\ No newline at end of file
+1;
diff --git a/lib/Catmandu/Fix/marc_xml.pm b/lib/Catmandu/Fix/marc_xml.pm
index ebb7f8c..5a654d4 100644
--- a/lib/Catmandu/Fix/marc_xml.pm
+++ b/lib/Catmandu/Fix/marc_xml.pm
@@ -7,6 +7,8 @@ use Catmandu::Exporter::MARC::XML;
use Catmandu::Util qw(:is :data);
use Catmandu::Fix::Has;
+with 'Catmandu::Fix::Inlineable';
+
our $VERSION = '0.218';
has path => (fix_arg => 1);
@@ -31,7 +33,7 @@ sub fix {
Catmandu::Fix::marc_xml - transform a Catmandu MARC record into MARCXML
=head1 SYNOPSIS
-
+
# Transforms the 'record' key into an MARCXML string
marc_xml('record')
diff --git a/t/18-inlineable.t b/t/18-inlineable.t
new file mode 100644
index 0000000..ffef943
--- /dev/null
+++ b/t/18-inlineable.t
@@ -0,0 +1,87 @@
+use strict;
+use warnings;
+
+use Test::More tests => 16;
+
+use Catmandu::Fix::marc_map as => 'marc_map';
+use Catmandu::Fix::marc_add as => 'marc_add';
+use Catmandu::Fix::marc_set as => 'marc_set';
+use Catmandu::Fix::marc_remove as => 'marc_remove';
+use Catmandu::Fix::marc_xml as => 'marc_xml';
+
+use Catmandu::Importer::JSON;
+
+my $importer = Catmandu::Importer::JSON->new( file => 't/old_new.json' );
+
+my $fixer = Catmandu::Fix->new(fixes => [
+ q|add_field(my.deep.field,foo)|,
+ q|add_field(my.deep.array.$append,red)|,
+ q|add_field(my.deep.array.$append,green)|,
+ q|add_field(my.deep.array.$append,blue)|,
+]);
+
+my $records = $fixer->fix($importer)->to_array;
+
+ok(@$records == 2 , "Found 2 records");
+
+{
+ is marc_map($records->[0],'245a','title')->{title}, q|ActivePerl with ASP and ADO /|, q|marc_map(245a)|;
+ is marc_map($records->[0],'001','id')->{id} , q|fol05731351| , q|marc_map(001)|;
+ ok ! defined(scalar marc_map($records->[0],'191','test')->{test}) , q|marc_map(191) not defined|;
+ ok ! defined(scalar marc_map($records->[0],'245x','test')->{test}) , q|marc_map(245x) not defined|;
+}
+
+{
+ my $res = marc_map($records->[0],'630','test.$append')->{test};
+ ok(@$res == 2 , q|marc_map(630)|);
+}
+
+{
+ marc_add($records->[0],'900', a => 'test');
+ is scalar marc_map($records->[0],'900a','test')->{test}, q|test|, q|marc_add(900)|;
+}
+
+{
+ marc_add($records->[0],'901', a => '$.my.deep.field');
+ is scalar marc_map($records->[0],'901a','test2')->{test2}, q|foo|, q|marc_add(901)|;
+}
+
+{
+ marc_add($records->[0],'902', a => '$.my.deep.array');
+ is scalar marc_map($records->[0],'902a','test3')->{test3}, q|redgreenblue|, q|marc_add(902)|;
+}
+
+{
+ marc_set($records->[0],'010b', 'test');
+ is scalar marc_map($records->[0],'010b','test4')->{test4}, q|test|, q|marc_set(010)|;
+}
+
+{
+ marc_set($records->[0],'010b', '$.my.deep.field');
+ is scalar marc_map($records->[0],'010b','test5')->{test5}, q|foo|, q|marc_set(010)|;
+}
+
+{
+ marc_remove($records->[0],'900');
+ ok ! defined scalar marc_map($records->[0],'900a','test6')->{test6} , q|marc_map(900) removed|;
+}
+
+{
+ my $f050 = marc_map($records->[0],'050ba','test7',-pluck=>1)->{test7};
+ is $f050 , "M33 2000QA76.73.P22" , q|pluck test|;
+}
+
+{
+ my $f260c = marc_map($records->[0],'260c','test8',-value=>'OK')->{test8};
+ is $f260c , "OK" , q|value test|;
+}
+
+{
+ my $f260h = marc_map($records->[0],'260h','test9',-value=>'BAD')->{test9};
+ ok ! $f260h , q|value test|;
+}
+
+{
+ my $xml = marc_xml($records->[0],'record')->{record};
+ like $xml , qr/.*xmlns.*/ , q|marc_xml|;
+}
--
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