/usr/share/perl5/Catmandu/Fix/Condition/marc_match.pm is in libcatmandu-marc-perl 0.214-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | package Catmandu::Fix::Condition::marc_match;
use Catmandu::Sane;
use Catmandu::Fix::marc_map;
use Catmandu::Fix::Condition::all_match;
use Catmandu::Fix::set_field;
use Catmandu::Fix::remove_field;
use Moo;
use Catmandu::Fix::Has;
with 'Catmandu::Fix::Condition';
has marc_path => (fix_arg => 1);
has value => (fix_arg => 1);
sub emit {
my ($self,$fixer,$label) = @_;
my $perl;
my $tmp_var = '_tmp_' . int(rand(9999));
my $marc_map = Catmandu::Fix::marc_map->new($self->marc_path , "$tmp_var.\$append");
$perl .= $marc_map->emit($fixer,$label);
my $all_match = Catmandu::Fix::Condition::all_match->new("$tmp_var.*",$self->value);
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_match - Conditionals on MARC fields
=head1 SYNOPSIS
# marc_match(MARC_PATH,REGEX)
if marc_match('245','My funny title')
add_field('my.funny.title','true')
end
=head1 DESCRIPTION
Read our Wiki pages at L<https://github.com/LibreCat/Catmandu/wiki/Fixes> for a complete
overview of the Fix language.
=head1 SEE ALSO
L<Catmandu::Fix>
=cut
1;
|