[libcatmandu-marc-perl] 156/208: new condition marc_has_ref

[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 454e35723c2be7cf378e8b684cf64ec9796a08e1
Author: Carsten Klee <cKlee at users.noreply.github.com>
Date:   Thu Jun 29 08:42:55 2017 +0200

    new condition marc_has_ref
---
 lib/Catmandu/Fix/Condition/marc_has_ref.pm | 81 ++++++++++++++++++++++++++++++
 t/25-marc_has_ref.t                        | 31 ++++++++++++
 2 files changed, 112 insertions(+)

diff --git a/lib/Catmandu/Fix/Condition/marc_has_ref.pm b/lib/Catmandu/Fix/Condition/marc_has_ref.pm
new file mode 100644
index 0000000..1053b43
--- /dev/null
+++ b/lib/Catmandu/Fix/Condition/marc_has_ref.pm
@@ -0,0 +1,81 @@
+package Catmandu::Fix::Condition::marc_has_ref;
+use Catmandu::Sane;
+use Catmandu::Fix::marc_spec;
+use Catmandu::Fix::Condition::exists;
+use Catmandu::Fix::set_field;
+use Catmandu::Fix::remove_field;
+use Moo;
+use Catmandu::Fix::Has;
+
+our $VERSION = '1.12';
+
+with 'Catmandu::Fix::Condition';
+
+has marc_spec  => (fix_arg => 1);
+
+sub emit {
+    my ($self,$fixer,$label) = @_;
+
+    my $perl;
+
+    my $tmp_var  = '_tmp_' . int(rand(9999));
+    my $marc_spec = Catmandu::Fix::marc_spec->new($self->marc_spec , "$tmp_var.\$append");
+    $perl .= $marc_spec->emit($fixer,$label);
+
+    my $all_match    = Catmandu::Fix::Condition::exists->new("$tmp_var");
+    my $remove_field = Catmandu::Fix::remove_field->new($tmp_var);
+
+    my $pass_fixes = $self->pass_fixes;
+    my $fail_fixes = $self->fail_fixes;
+
+    $all_match->pass_fixes([ $remove_field , @$pass_fixes ]);
+    $all_match->fail_fixes([ $remove_field , @$fail_fixes ]);
+
+    $perl .= $all_match->emit($fixer,$label);
+
+    $perl;
+}
+
+=head1 NAME
+
+Catmandu::Fix::Condition::marc_has_ref - Test if a MARCspec references data
+
+=head1 SYNOPSIS
+
+   # marc_has_ref(MARCspec)
+
+   unless marc_has_ref('LDR{/6=\a}{/7=\a|/7=\c|/7=\d|/7=\m}')
+        set_field('type','Book')
+   end
+
+=head1 DESCRIPTION
+
+Evaluate the enclosing fixes only if the MARCspec does reference data.
+
+Does the same like  L<marc_has|Catmandu::Fix::Condition::marc_has> but uses 
+MARCspec - A common MARC record path language.
+
+See L<MARCspec - A common MARC record path language|http://marcspec.github.io/MARCspec/>
+for documentation on the path syntax.
+
+=head1 METHODS
+
+=head2 marc_has_ref(MARCspec)
+
+Evaluates to true when the MARCspec references data, false otherwise.
+
+=head1 SEE ALSO
+
+=over
+
+=item * L<Catmandu::Fix::marc_has>
+
+=item * L<Catmandu::Fix::marc_match>
+
+=item * L<Catmandu::Fix::marc_has_many>
+
+=back
+
+=cut
+
+1;
diff --git a/t/25-marc_has_ref.t b/t/25-marc_has_ref.t
new file mode 100644
index 0000000..8bbe7e2
--- /dev/null
+++ b/t/25-marc_has_ref.t
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use warnings qw(FATAL utf8);
+use utf8;
+
+use Test::More;
+
+use Catmandu::Importer::MARC;
+use Catmandu::Fix;
+
+
+my $fixes = <<EOF;
+if marc_has_ref('LDR{/6=\\a}{/7=\\a|/7=\\c|/7=\\d|/7=\\m}')
+  add_field(type,'Book')
+end
+
+if marc_has_ref('LDR{/6=\\a}{/7=\\b}')
+  set_field(type,'Other')
+end
+
+EOF
+
+my $fixer = Catmandu::Fix->new(fixes => [$fixes]);
+my $importer = Catmandu::Importer::MARC->new( file => 't/camel9.mrc' );
+my $records = $fixer->fix($importer)->to_array;
+
+is $records->[0]->{type}, 'Book';
+
+done_testing;

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