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 <[email protected]> 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 _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
