[libcatmandu-marc-perl] 199/208: Adding explicit all_match , any_match operations
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:50 UTC 2017
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 ec685a6104a680f408a09fb42454ec3ccd1d70dc
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Wed Sep 27 12:24:47 2017 +0200
Adding explicit all_match , any_match operations
---
.../Condition/{marc_match.pm => marc_all_match.pm} | 28 +++++---
lib/Catmandu/Fix/Condition/marc_any_match.pm | 81 ++++++++++++++++++++++
lib/Catmandu/Fix/Condition/marc_match.pm | 10 +--
3 files changed, 106 insertions(+), 13 deletions(-)
diff --git a/lib/Catmandu/Fix/Condition/marc_match.pm b/lib/Catmandu/Fix/Condition/marc_all_match.pm
similarity index 58%
copy from lib/Catmandu/Fix/Condition/marc_match.pm
copy to lib/Catmandu/Fix/Condition/marc_all_match.pm
index 26230ed..514bd0a 100644
--- a/lib/Catmandu/Fix/Condition/marc_match.pm
+++ b/lib/Catmandu/Fix/Condition/marc_all_match.pm
@@ -1,4 +1,4 @@
-package Catmandu::Fix::Condition::marc_match;
+package Catmandu::Fix::Condition::marc_all_match;
use Catmandu::Sane;
use Catmandu::Fix::marc_map;
use Catmandu::Fix::Condition::all_match;
@@ -23,7 +23,7 @@ sub emit {
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 $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;
@@ -39,30 +39,42 @@ sub emit {
=head1 NAME
-Catmandu::Fix::Condition::marc_match - Test if a MARC (sub)field matches a value
+Catmandu::Fix::Condition::marc_all_match - Test if a MARC (sub)field matches a value
=head1 SYNOPSIS
- # marc_match(MARC_PATH,REGEX)
+ # marc_all_match(MARC_PATH,REGEX)
- if marc_match('245','My funny title')
+ # Match if 245 contains the value "My funny title"
+ if marc_all_match('245','My funny title')
add_field('my.funny.title','true')
end
+ # Match if 245a contains the value "My funny title"
+ if marc_all_match('245a','My funny title')
+ add_field('my.funny.title','true')
+ end
+
+ # Match if all 650 fields contain digits
+ if marc_all_match('650','[0-9]')
+ add_field('has_digits','true')
+ end
+
=head1 DESCRIPTION
Evaluate the enclosing fixes only if the MARC (sub)field matches a
-regular expression.
+regular expression. When the MARC field is a repeated fiels, then all
+the MARC fields should match the regular expression.
=head1 METHODS
-=head2 marc_match(MARC_PATH, REGEX)
+=head2 marc_all_match(MARC_PATH, REGEX)
Evaluates to true when the MARC_PATH values matches the REGEX, false otherwise.
=head1 SEE ALSO
-L<Catmandu::Fix>
+L<Catmandu::Fix::marc_any_match>
=cut
diff --git a/lib/Catmandu/Fix/Condition/marc_any_match.pm b/lib/Catmandu/Fix/Condition/marc_any_match.pm
new file mode 100644
index 0000000..2165928
--- /dev/null
+++ b/lib/Catmandu/Fix/Condition/marc_any_match.pm
@@ -0,0 +1,81 @@
+package Catmandu::Fix::Condition::marc_any_match;
+use Catmandu::Sane;
+use Catmandu::Fix::marc_map;
+use Catmandu::Fix::Condition::any_match;
+use Catmandu::Fix::set_field;
+use Catmandu::Fix::remove_field;
+use Moo;
+use Catmandu::Fix::Has;
+
+our $VERSION = '1.18';
+
+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 $any_match = Catmandu::Fix::Condition::any_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;
+
+ $any_match->pass_fixes([ $remove_field , @$pass_fixes ]);
+ $any_match->fail_fixes([ $remove_field , @$fail_fixes ]);
+
+ $perl .= $any_match->emit($fixer,$label);
+
+ $perl;
+}
+
+=head1 NAME
+
+Catmandu::Fix::Condition::marc_any_match - Test if a MARC (sub)field matches a value
+
+=head1 SYNOPSIS
+
+ # marc_any_match(MARC_PATH,REGEX)
+
+ # Match if 245 contains the value "My funny title"
+ if marc_any_match('245','My funny title')
+ add_field('my.funny.title','true')
+ end
+
+ # Match if 245a contains the value "My funny title"
+ if marc_any_match('245a','My funny title')
+ add_field('my.funny.title','true')
+ end
+
+ # Match if at least one 650 field contains digits
+ if marc_any_match('650','[0-9]')
+ add_field('has_digits','true')
+ end
+
+=head1 DESCRIPTION
+
+Evaluate the enclosing fixes only if the MARC (sub)field matches a
+regular expression. When the MARC field is a repeated fiels, then at
+least one MARC fields should match the regular expression.
+
+=head1 METHODS
+
+=head2 marc_any_match(MARC_PATH, REGEX)
+
+Evaluates to true when the MARC_PATH values matches the REGEX, false otherwise.
+
+=head1 SEE ALSO
+
+L<Catmandu::Fix::marc_all_match>
+
+=cut
+
+1;
diff --git a/lib/Catmandu/Fix/Condition/marc_match.pm b/lib/Catmandu/Fix/Condition/marc_match.pm
index 26230ed..cead25d 100644
--- a/lib/Catmandu/Fix/Condition/marc_match.pm
+++ b/lib/Catmandu/Fix/Condition/marc_match.pm
@@ -1,7 +1,7 @@
package Catmandu::Fix::Condition::marc_match;
use Catmandu::Sane;
use Catmandu::Fix::marc_map;
-use Catmandu::Fix::Condition::all_match;
+use Catmandu::Fix::Condition::any_match;
use Catmandu::Fix::set_field;
use Catmandu::Fix::remove_field;
use Moo;
@@ -23,16 +23,16 @@ sub emit {
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 $any_match = Catmandu::Fix::Condition::any_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 ]);
+ $any_match->pass_fixes([ $remove_field , @$pass_fixes ]);
+ $any_match->fail_fixes([ $remove_field , @$fail_fixes ]);
- $perl .= $all_match->emit($fixer,$label);
+ $perl .= $any_match->emit($fixer,$label);
$perl;
}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-marc-perl.git
More information about the Pkg-perl-cvs-commits
mailing list