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 but uses +MARCspec - A common MARC record path language. + +See L +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 + +=item * L + +=item * L + +=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 = <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;