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 3096e92551184bfcc2a6ab6aed151fadff4ebbae Author: Patrick Hochstenbach <[email protected]> Date: Thu Jun 29 16:01:29 2017 +0200 Updating POD --- lib/Catmandu/Fix/marc_remove.pm | 2 +- lib/Catmandu/Fix/marc_replace_all.pm | 30 +++++++------------ lib/Catmandu/Fix/marc_set.pm | 4 +-- lib/Catmandu/MARC.pm | 58 ++++++++++++++++++++++++++++++++++++ 4 files changed, 72 insertions(+), 22 deletions(-) diff --git a/lib/Catmandu/Fix/marc_remove.pm b/lib/Catmandu/Fix/marc_remove.pm index f653a08..62087e6 100644 --- a/lib/Catmandu/Fix/marc_remove.pm +++ b/lib/Catmandu/Fix/marc_remove.pm @@ -36,7 +36,7 @@ Remove (sub)fields in a MARC record =head1 METHODS -=head2 marc_remove( MARC_PATH , [OPT1:VAL, OPT2: VAL]) +=head2 marc_remove(MARC_PATH) Delete the (sub)fields from the MARC record as indicated by the MARC_PATH. diff --git a/lib/Catmandu/Fix/marc_replace_all.pm b/lib/Catmandu/Fix/marc_replace_all.pm index 3363fb5..1f0e2de 100644 --- a/lib/Catmandu/Fix/marc_replace_all.pm +++ b/lib/Catmandu/Fix/marc_replace_all.pm @@ -23,44 +23,36 @@ sub fix { =head1 NAME -Catmandu::Fix::marc_set - set a marc value of one (sub)field to a new value +Catmandu::Fix::marc_replace_all - regex replace (sub)field values in a MARC file =head1 SYNOPSIS - # Set a field in the leader - if marc_match('LDR/6','c') - marc_set('LDR/6','p') - end + # Append to all the 650-p values the string "xyz" + marc_replace_all('650p','$','xyz') - # Set all the 650-p fields to 'test' - marc_set('650p','test') - - # Set the 100-a subfield where indicator-1 is 3 - marc_set('100[3]a','Farquhar family.') - - # Copy data from another field in a subfield - marc_set('100a','$.my.deep.field') + # Replace all 'Joe'-s in 100a to 'Joey' + marc_replace_all('100a','\bJoe\b','Joey') =head1 DESCRIPTION -Set the value of a MARC subfield to a new value. +Use regex search and replace on MARC field values. =head1 METHODS -=head2 marc_set( MARC_PATH , VALUE , [OPT1:VAL, OPT2: VAL]) +=head2 marc_replace_all(MARC_PATH , REGEX, VALUE) -Set a MARC subfield to a particular new value. This valeu can be a literal or -reference an existing field in the record using the dollar JSON_PATH syntax. +For each (sub)field matching the MARC_PATH replace the pattern found by REGEX to +a new VALUE =head1 INLINE This Fix can be used inline in a Perl script: - use Catmandu::Fix::marc_set as => 'marc_xmarc_setml'; + use Catmandu::Fix::marc_replace_all as => 'marc_replace_all'; my $data = { record => [...] }; - $data = marc_set($data, '245a', 'test'); + $data = marc_replace_all($data, '245a', 'test' , 'rest'); =head1 SEE ALSO diff --git a/lib/Catmandu/Fix/marc_set.pm b/lib/Catmandu/Fix/marc_set.pm index b6d02e9..e8098ab 100644 --- a/lib/Catmandu/Fix/marc_set.pm +++ b/lib/Catmandu/Fix/marc_set.pm @@ -45,7 +45,7 @@ Set the value of a MARC subfield to a new value. =head1 METHODS -=head2 marc_set( MARC_PATH , VALUE , [OPT1:VAL, OPT2: VAL]) +=head2 marc_set(MARC_PATH , VALUE) Set a MARC subfield to a particular new value. This valeu can be a literal or reference an existing field in the record using the dollar JSON_PATH syntax. @@ -54,7 +54,7 @@ reference an existing field in the record using the dollar JSON_PATH syntax. This Fix can be used inline in a Perl script: - use Catmandu::Fix::marc_set as => 'marc_xmarc_setml'; + use Catmandu::Fix::marc_set as => 'marc_set'; my $data = { record => [...] }; diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm index b18863c..f8b4531 100644 --- a/lib/Catmandu/MARC.pm +++ b/lib/Catmandu/MARC.pm @@ -264,6 +264,64 @@ sub marc_replace_all { $data; } +sub marc_replace_all { + my ($self,$data,$marc_path,$regex,$value) = @_; + my $record = $data->{'record'}; + + return $data unless defined $record; + + if ($value =~ /^\$\.(\S+)/) { + my $path = $1; + $value = Catmandu::Util::data_at($path,$data); + } + + if (Catmandu::Util::is_array_ref $value) { + $value = $value->[-1]; + } + elsif (Catmandu::Util::is_hash_ref $value) { + my $last; + for (keys %$value) { + $last = $value->{$_}; + } + $value = $last; + } + + my $context = $self->compile_marc_path($marc_path, subfield_wildcard => 1); + + confess "invalid marc path" unless $context; + + for my $field (@$record) { + my ($tag, $ind1, $ind2, @subfields) = @$field; + + if ($context->{is_regex_field}) { + next unless $tag =~ $context->{field_regex}; + } + else { + next unless $tag eq $context->{field}; + } + + if (defined $context->{ind1}) { + if (!defined $ind1 || $ind1 ne $context->{ind1}) { + next; + } + } + if (defined $context->{ind2}) { + if (!defined $ind2 || $ind2 ne $context->{ind2}) { + next; + } + } + + for (my $i = 0; $i < @subfields; $i += 2) { + if ($subfields[$i] =~ $context->{subfield}) { + $field->[$i + 4] =~ s{$regex}{$value}g; + } + } + } + + $data; +} + + sub marc_set { my ($self,$data,$marc_path,$value,%opts) = @_; my $record = $data->{'record'}; -- 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
