Nick Clemens
77f3d48dee
This patch corrects handling of subfield 0 when copying/moving. Before these patches copying from subfield 0 would copy the entire field. We also correct an error that if moving a single subfield, we can leave behind empty fields with no subfields. They should be deleted. To test: 1 - Define a new MARC Modification template with actions: Delete field 100$0 Add new field 100$0 with value Test Update existing or add new field 100$0 with value TestUpdated Move field 100$0 to 600$0 Copy field 600$0 to 100$0 Copy and replace field 245$0 to 700$0 2 - Define a new record like: LDR 00334nam a22001217a 4500 003 ff 005 20201102111604.0 008 201102b xxu||||| |||| 00| 0 eng d 040 _ _ ‡cvsd 100 1 _ ‡012345‡aKnuth, Donal Ervin‡d1938 245 _ _ ‡012345‡aThe aty of computer programming‡cDonald E. Knuth 650 _ 0 ‡042‡aComputer programming‡9462 3 - Modify this record using the template above 4 - Note that entier 245 is copied to 700, same for 600 field 5 - Apply patch 6 - Now only subfields 0 are copied Signed-off-by: Fridolin Somers <fridolin.somers@biblibre.com> Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com> Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
672 lines
20 KiB
Perl
672 lines
20 KiB
Perl
package Koha::SimpleMARC;
|
|
|
|
# Copyright 2009 Kyle M. Hall <kyle.m.hall@gmail.com>
|
|
|
|
# Koha is free software; you can redistribute it and/or modify it
|
|
# under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# Koha is distributed in the hope that it will be useful, but
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
|
|
|
|
|
use Modern::Perl;
|
|
|
|
#use MARC::Record;
|
|
|
|
require Exporter;
|
|
|
|
our @ISA = qw(Exporter);
|
|
our %EXPORT_TAGS = ( 'all' => [ qw(
|
|
|
|
) ] );
|
|
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
|
|
|
our @EXPORT = qw(
|
|
read_field
|
|
add_field
|
|
update_field
|
|
copy_field
|
|
copy_and_replace_field
|
|
move_field
|
|
delete_field
|
|
field_exists
|
|
field_equals
|
|
);
|
|
|
|
|
|
our $debug = 0;
|
|
|
|
=head1 NAME
|
|
|
|
SimpleMARC - Perl module for making simple MARC record alterations.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use SimpleMARC;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
SimpleMARC is designed to make writing scripts
|
|
to modify MARC records simple and easy.
|
|
|
|
Every function in the modules requires a
|
|
MARC::Record object as its first parameter.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Kyle Hall <lt>kyle.m.hall@gmail.com<gt>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
Copyright (C) 2009 by Kyle Hall
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
|
it under the same terms as Perl itself, either Perl version 5.8.7 or,
|
|
at your option, any later version of Perl 5 you may have available.
|
|
|
|
=head1 FUNCTIONS
|
|
|
|
=head2 copy_field
|
|
|
|
copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex[, $n ] ] );
|
|
|
|
Copies a value from one field to another. If a regular expression ( $regex ) is supplied,
|
|
the value will be transformed by the given regex before being copied into the new field.
|
|
Example: $regex = { search => 'Old Text', replace => 'Replacement Text', modifiers => 'g' };
|
|
|
|
If $n is passed, copy_field will only copy the Nth field of the list of fields.
|
|
E.g. $n = 1 will only use the first field's value, $n = 2 will use only the 2nd field's value.
|
|
|
|
=cut
|
|
|
|
sub copy_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fromFieldName = $params->{from_field};
|
|
my $fromSubfieldName = $params->{from_subfield};
|
|
my $toFieldName = $params->{to_field};
|
|
my $toSubfieldName = $params->{to_subfield};
|
|
my $regex = $params->{regex};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
|
|
|
|
|
|
if ( not $fromSubfieldName
|
|
or $fromSubfieldName eq ''
|
|
or not $toSubfieldName
|
|
or $toSubfieldName eq '' ) {
|
|
_copy_move_field(
|
|
{ record => $record,
|
|
from_field => $fromFieldName,
|
|
to_field => $toFieldName,
|
|
regex => $regex,
|
|
field_numbers => $field_numbers,
|
|
action => 'copy',
|
|
}
|
|
);
|
|
} else {
|
|
_copy_move_subfield(
|
|
{ record => $record,
|
|
from_field => $fromFieldName,
|
|
from_subfield => $fromSubfieldName,
|
|
to_field => $toFieldName,
|
|
to_subfield => $toSubfieldName,
|
|
regex => $regex,
|
|
field_numbers => $field_numbers,
|
|
action => 'copy',
|
|
}
|
|
);
|
|
}
|
|
}
|
|
|
|
sub copy_and_replace_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fromFieldName = $params->{from_field};
|
|
my $fromSubfieldName = $params->{from_subfield};
|
|
my $toFieldName = $params->{to_field};
|
|
my $toSubfieldName = $params->{to_subfield};
|
|
my $regex = $params->{regex};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
|
|
|
|
|
|
if ( !defined $fromSubfieldName or $fromSubfieldName eq ''
|
|
or !defined $toSubfieldName or $toSubfieldName eq ''
|
|
) {
|
|
_copy_move_field(
|
|
{ record => $record,
|
|
from_field => $fromFieldName,
|
|
to_field => $toFieldName,
|
|
regex => $regex,
|
|
field_numbers => $field_numbers,
|
|
action => 'replace',
|
|
}
|
|
);
|
|
} else {
|
|
_copy_move_subfield(
|
|
{ record => $record,
|
|
from_field => $fromFieldName,
|
|
from_subfield => $fromSubfieldName,
|
|
to_field => $toFieldName,
|
|
to_subfield => $toSubfieldName,
|
|
regex => $regex,
|
|
field_numbers => $field_numbers,
|
|
action => 'replace',
|
|
}
|
|
);
|
|
}
|
|
}
|
|
|
|
sub update_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $subfieldName = $params->{subfield};
|
|
my @values = @{ $params->{values} };
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
if ( ! ( $record && $fieldName ) ) { return; }
|
|
|
|
if ( not defined $subfieldName or $subfieldName eq '' ) {
|
|
# FIXME I'm not sure the actual implementation is correct.
|
|
die "This action is not implemented yet";
|
|
#_update_field({ record => $record, field => $fieldName, values => \@values });
|
|
} else {
|
|
_update_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, values => \@values, field_numbers => $field_numbers });
|
|
}
|
|
}
|
|
|
|
=head2 add_field
|
|
|
|
add_field({
|
|
record => $record,
|
|
field => $fieldName,
|
|
subfield => $subfieldName,
|
|
values => \@values,
|
|
field_numbers => $field_numbers,
|
|
});
|
|
|
|
Adds a new field/subfield with supplied value(s).
|
|
This function always add a new field as opposed to 'update_field' which will
|
|
either update if field exists and add if it does not.
|
|
|
|
=cut
|
|
|
|
|
|
sub add_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $subfieldName = $params->{subfield};
|
|
my @values = @{ $params->{values} };
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
if ( ! ( $record && $fieldName ) ) { return; }
|
|
if ( $fieldName > 10 ) {
|
|
foreach my $value ( @values ) {
|
|
my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $value );
|
|
$record->append_fields( $field );
|
|
}
|
|
} else {
|
|
foreach my $value ( @values ) {
|
|
my $field = MARC::Field->new( $fieldName, $value );
|
|
$record->append_fields( $field );
|
|
}
|
|
}
|
|
}
|
|
|
|
sub _update_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my @values = @{ $params->{values} };
|
|
|
|
my $i = 0;
|
|
if ( my @fields = $record->field( $fieldName ) ) {
|
|
@values = ($values[0]) x scalar( @fields )
|
|
if @values == 1;
|
|
foreach my $field ( @fields ) {
|
|
$field->update( $values[$i++] );
|
|
}
|
|
} else {
|
|
## Field does not exists, create it
|
|
if ( $fieldName < 10 ) {
|
|
foreach my $value ( @values ) {
|
|
my $field = MARC::Field->new( $fieldName, $value );
|
|
$record->append_fields( $field );
|
|
}
|
|
} else {
|
|
warn "Invalid operation, trying to add a new field without subfield";
|
|
}
|
|
}
|
|
}
|
|
|
|
sub _update_subfield {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $subfieldName = $params->{subfield};
|
|
my @values = @{ $params->{values} };
|
|
my $dont_erase = $params->{dont_erase};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
my $i = 0;
|
|
|
|
my @fields = $record->field( $fieldName );
|
|
|
|
if ( @$field_numbers ) {
|
|
@fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
|
|
}
|
|
|
|
if ( @fields ) {
|
|
unless ( $dont_erase ) {
|
|
@values = ($values[0]) x scalar( @fields )
|
|
if @values == 1;
|
|
foreach my $field ( @fields ) {
|
|
$field->update( "$subfieldName" => $values[$i++] );
|
|
}
|
|
}
|
|
if ( $i <= scalar ( @values ) - 1 ) {
|
|
foreach my $field ( @fields ) {
|
|
foreach my $j ( $i .. scalar( @values ) - 1) {
|
|
$field->add_subfields( "$subfieldName" => $values[$j] );
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
## Field does not exist, create it.
|
|
foreach my $value ( @values ) {
|
|
my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
|
|
$record->append_fields( $field );
|
|
}
|
|
}
|
|
}
|
|
|
|
=head2 read_field
|
|
|
|
my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
|
|
|
|
Returns an array of field values for the given field and subfield
|
|
|
|
If $n is given, it will return only the $nth value of the array.
|
|
E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
|
|
|
|
=cut
|
|
|
|
sub read_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $subfieldName = $params->{subfield};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
if ( not defined $subfieldName or $subfieldName eq '' ) {
|
|
_read_field({ record => $record, field => $fieldName, field_numbers => $field_numbers });
|
|
} else {
|
|
_read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
|
|
}
|
|
}
|
|
|
|
sub _read_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
my @fields = $record->field( $fieldName );
|
|
|
|
return unless @fields;
|
|
|
|
return map { $_->data() } @fields
|
|
if $fieldName < 10;
|
|
|
|
my @values;
|
|
if ( @$field_numbers ) {
|
|
for my $field_number ( @$field_numbers ) {
|
|
if ( $field_number <= scalar( @fields ) ) {
|
|
for my $sf ( $fields[$field_number - 1]->subfields ) {
|
|
push @values, $sf->[1];
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
foreach my $field ( @fields ) {
|
|
for my $sf ( $field->subfields ) {
|
|
push @values, $sf->[1];
|
|
}
|
|
}
|
|
}
|
|
|
|
return @values;
|
|
}
|
|
|
|
sub _read_subfield {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $subfieldName = $params->{subfield};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
my @fields = $record->field( $fieldName );
|
|
|
|
return unless @fields;
|
|
|
|
my @values;
|
|
foreach my $field ( @fields ) {
|
|
my @sf = $field->subfield( $subfieldName );
|
|
push( @values, @sf );
|
|
}
|
|
|
|
if ( @values and @$field_numbers ) {
|
|
@values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
|
|
}
|
|
|
|
return @values;
|
|
}
|
|
|
|
=head2 field_exists
|
|
|
|
@field_numbers = field_exists( $record, $fieldName[, $subfieldName ]);
|
|
|
|
Returns the field numbers or an empty array.
|
|
|
|
=cut
|
|
|
|
sub field_exists {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $subfieldName = $params->{subfield};
|
|
|
|
if ( ! $record ) { return; }
|
|
|
|
my @field_numbers = ();
|
|
my $current_field_number = 1;
|
|
for my $field ( $record->field( $fieldName ) ) {
|
|
if ( $subfieldName ) {
|
|
push @field_numbers, $current_field_number
|
|
if $field->subfield( $subfieldName );
|
|
} else {
|
|
push @field_numbers, $current_field_number;
|
|
}
|
|
$current_field_number++;
|
|
}
|
|
|
|
return \@field_numbers;
|
|
}
|
|
|
|
=head2 field_equals
|
|
|
|
$bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex ] ]);
|
|
|
|
Returns true if the field equals the given value, false otherwise.
|
|
|
|
If a regular expression ( $regex ) is supplied, the value will be compared using
|
|
the given regex. Example: $regex = 'sought_text'
|
|
|
|
=cut
|
|
|
|
sub field_equals {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $value = $params->{value};
|
|
my $fieldName = $params->{field};
|
|
my $subfieldName = $params->{subfield};
|
|
my $is_regex = $params->{is_regex};
|
|
|
|
if ( ! $record ) { return; }
|
|
|
|
my @field_numbers = ();
|
|
my $current_field_number = 1;
|
|
FIELDS: for my $field ( $record->field( $fieldName ) ) {
|
|
my @subfield_values;
|
|
if ( $field->is_control_field ) {
|
|
push @subfield_values, $field->data;
|
|
} else {
|
|
@subfield_values =
|
|
$subfieldName
|
|
? $field->subfield($subfieldName)
|
|
: map { $_->[1] } $field->subfields;
|
|
}
|
|
|
|
SUBFIELDS: for my $subfield_value ( @subfield_values ) {
|
|
if (
|
|
(
|
|
$is_regex and $subfield_value =~ m/$value/
|
|
) or (
|
|
$subfield_value eq $value
|
|
)
|
|
) {
|
|
push @field_numbers, $current_field_number;
|
|
last SUBFIELDS;
|
|
}
|
|
}
|
|
$current_field_number++;
|
|
}
|
|
|
|
return \@field_numbers;
|
|
}
|
|
|
|
=head2 move_field
|
|
|
|
move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
|
|
|
|
Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
|
|
the value will be transformed by the given regex before being moved into the new field.
|
|
Example: $regex = 's/Old Text/Replacement Text/'
|
|
|
|
If $n is passed, only the Nth field will be moved. $n = 1
|
|
will move the first repeatable field, $n = 3 will move the third.
|
|
|
|
=cut
|
|
|
|
sub move_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fromFieldName = $params->{from_field};
|
|
my $fromSubfieldName = $params->{from_subfield};
|
|
my $toFieldName = $params->{to_field};
|
|
my $toSubfieldName = $params->{to_subfield};
|
|
my $regex = $params->{regex};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
if ( !defined $fromSubfieldName
|
|
or $fromSubfieldName eq ''
|
|
or !defined $toSubfieldName
|
|
or $toSubfieldName eq '' ) {
|
|
_copy_move_field(
|
|
{ record => $record,
|
|
from_field => $fromFieldName,
|
|
to_field => $toFieldName,
|
|
regex => $regex,
|
|
field_numbers => $field_numbers,
|
|
action => 'move',
|
|
}
|
|
);
|
|
} else {
|
|
_copy_move_subfield(
|
|
{ record => $record,
|
|
from_field => $fromFieldName,
|
|
from_subfield => $fromSubfieldName,
|
|
to_field => $toFieldName,
|
|
to_subfield => $toSubfieldName,
|
|
regex => $regex,
|
|
field_numbers => $field_numbers,
|
|
action => 'move',
|
|
}
|
|
);
|
|
}
|
|
}
|
|
|
|
=head2 _delete_field
|
|
|
|
_delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
|
|
|
|
Deletes the given field.
|
|
|
|
If $n is passed, only the Nth field will be deleted. $n = 1
|
|
will delete the first repeatable field, $n = 3 will delete the third.
|
|
|
|
=cut
|
|
|
|
sub delete_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $subfieldName = $params->{subfield};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
if ( !defined $subfieldName or $subfieldName eq '' ) {
|
|
_delete_field({ record => $record, field => $fieldName, field_numbers => $field_numbers });
|
|
} else {
|
|
_delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
|
|
}
|
|
}
|
|
|
|
sub _delete_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
my @fields = $record->field( $fieldName );
|
|
|
|
if ( @$field_numbers ) {
|
|
@fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
|
|
}
|
|
foreach my $field ( @fields ) {
|
|
$record->delete_field( $field );
|
|
}
|
|
}
|
|
|
|
sub _delete_subfield {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fieldName = $params->{field};
|
|
my $subfieldName = $params->{subfield};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
|
|
my @fields = $record->field( $fieldName );
|
|
|
|
if ( @$field_numbers ) {
|
|
@fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
|
|
}
|
|
|
|
foreach my $field ( @fields ) {
|
|
$field->delete_subfield( code => $subfieldName );
|
|
$record->delete_field( $field ) unless $field->subfields();
|
|
}
|
|
}
|
|
|
|
|
|
sub _copy_move_field {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fromFieldName = $params->{from_field};
|
|
my $toFieldName = $params->{to_field};
|
|
my $regex = $params->{regex};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
my $action = $params->{action} || 'copy';
|
|
|
|
my @from_fields = $record->field( $fromFieldName );
|
|
if ( @$field_numbers ) {
|
|
@from_fields = map { $_ <= @from_fields ? $from_fields[ $_ - 1 ] : () } @$field_numbers;
|
|
}
|
|
|
|
my @new_fields;
|
|
for my $from_field ( @from_fields ) {
|
|
my $new_field = $from_field->clone;
|
|
$new_field->{_tag} = $toFieldName; # Should be replaced by set_tag, introduced by MARC::Field 2.0.4
|
|
if ( $regex and $regex->{search} ) {
|
|
for my $subfield ( $new_field->subfields ) {
|
|
my $value = $subfield->[1];
|
|
( $value ) = _modify_values({ values => [ $value ], regex => $regex });
|
|
$new_field->update( $subfield->[0], $value );
|
|
}
|
|
}
|
|
if ( $action eq 'move' ) {
|
|
$record->delete_field( $from_field )
|
|
}
|
|
elsif ( $action eq 'replace' ) {
|
|
my @to_fields = $record->field( $toFieldName );
|
|
if ( @to_fields ) {
|
|
$record->delete_field( $to_fields[0] );
|
|
}
|
|
}
|
|
push @new_fields, $new_field;
|
|
}
|
|
$record->append_fields( @new_fields );
|
|
}
|
|
|
|
sub _copy_move_subfield {
|
|
my ( $params ) = @_;
|
|
my $record = $params->{record};
|
|
my $fromFieldName = $params->{from_field};
|
|
my $fromSubfieldName = $params->{from_subfield};
|
|
my $toFieldName = $params->{to_field};
|
|
my $toSubfieldName = $params->{to_subfield};
|
|
my $regex = $params->{regex};
|
|
my $field_numbers = $params->{field_numbers} // [];
|
|
my $action = $params->{action} || 'copy';
|
|
|
|
my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
|
|
if ( @$field_numbers ) {
|
|
@values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
|
|
}
|
|
_modify_values({ values => \@values, regex => $regex });
|
|
my $dont_erase = $action eq 'copy' ? 1 : 0;
|
|
_update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values, dont_erase => $dont_erase });
|
|
|
|
# And delete if it's a move
|
|
if ( $action eq 'move' ) {
|
|
_delete_subfield({
|
|
record => $record,
|
|
field => $fromFieldName,
|
|
subfield => $fromSubfieldName,
|
|
field_numbers => $field_numbers,
|
|
});
|
|
}
|
|
}
|
|
|
|
sub _modify_values {
|
|
my ( $params ) = @_;
|
|
my $values = $params->{values};
|
|
my $regex = $params->{regex};
|
|
|
|
if ( $regex and $regex->{search} ) {
|
|
$regex->{modifiers} //= q||;
|
|
my @available_modifiers = qw( i g );
|
|
my $modifiers = q||;
|
|
for my $modifier ( split //, $regex->{modifiers} ) {
|
|
$modifiers .= $modifier
|
|
if grep {/$modifier/} @available_modifiers;
|
|
}
|
|
foreach my $value ( @$values ) {
|
|
if ( $modifiers =~ m/^(ig|gi)$/ ) {
|
|
$value =~ s/$regex->{search}/$regex->{replace}/ig;
|
|
}
|
|
elsif ( $modifiers eq 'i' ) {
|
|
$value =~ s/$regex->{search}/$regex->{replace}/i;
|
|
}
|
|
elsif ( $modifiers eq 'g' ) {
|
|
$value =~ s/$regex->{search}/$regex->{replace}/g;
|
|
}
|
|
else {
|
|
$value =~ s/$regex->{search}/$regex->{replace}/;
|
|
}
|
|
}
|
|
}
|
|
return @$values;
|
|
}
|
|
1;
|
|
__END__
|