new condition marc_has_ref

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;

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;