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 <[email protected]> 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 _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
