# Copyright 2009 Kyle M. Hall <kyle.m.hall@gmail.com>
-use Modern::Perl;
-
-#use MARC::Record;
-
-require Exporter;
-
-our @ISA = qw(Exporter);
-our %EXPORT_TAGS = ( 'all' => [ qw(
+# 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>.
-) ] );
-our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
-
-our @EXPORT = qw(
- read_field
- update_field
- copy_field
- move_field
- delete_field
- field_exists
- field_equals
-);
-
-our $VERSION = '0.01';
+use Modern::Perl;
-our $debug = 0;
+our (@ISA, @EXPORT_OK);
+BEGIN {
+ require Exporter;
+ our @ISA = qw(Exporter);
+
+ @EXPORT_OK = qw(
+ read_field
+ add_field
+ update_field
+ copy_field
+ copy_and_replace_field
+ move_field
+ delete_field
+ field_exists
+ field_equals
+ );
+}
=head1 NAME
my $toFieldName = $params->{to_field};
my $toSubfieldName = $params->{to_subfield};
my $regex = $params->{regex};
- my $n = $params->{n};
+ my $field_numbers = $params->{field_numbers} // [];
if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
- if ( not $fromSubfieldName or $fromSubfieldName eq ''
- or not $toSubfieldName or $toSubfieldName eq ''
- ) {
- _copy_field({
- record => $record,
- from_field => $fromFieldName,
- to_field => $toFieldName,
- regex => $regex,
- n => $n
- });
+ 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_subfield({
- record => $record,
- from_field => $fromFieldName,
- from_subfield => $fromSubfieldName,
- to_field => $toFieldName,
- to_subfield => $toSubfieldName,
- regex => $regex,
- n => $n
- });
+ _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_field {
- my ( $params ) = @_;
- my $record = $params->{record};
- my $fromFieldName = $params->{from_field};
- my $toFieldName = $params->{to_field};
- my $regex = $params->{regex};
- my $n = $params->{n};
-
- _copy_move_field({
- record => $record,
- from_field => $fromFieldName,
- to_field => $toFieldName,
- regex => $regex,
- n => $n
- });
-}
-
-sub _copy_subfield {
+sub copy_and_replace_field {
my ( $params ) = @_;
my $record = $params->{record};
my $fromFieldName = $params->{from_field};
my $toFieldName = $params->{to_field};
my $toSubfieldName = $params->{to_subfield};
my $regex = $params->{regex};
- my $n = $params->{n};
+ my $field_numbers = $params->{field_numbers} // [];
- my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
- @values = ( $values[$n-1] ) if ( $n );
- _modify_values({ values => \@values, regex => $regex });
+ if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
- update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values });
+
+ 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 $fieldName = $params->{field};
my $subfieldName = $params->{subfield};
my @values = @{ $params->{values} };
+ my $field_numbers = $params->{field_numbers} // [];
if ( ! ( $record && $fieldName ) ) { return; }
- if ( not $subfieldName or $subfieldName eq '' ) {
+ 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 });
+ _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 );
+ }
}
}
my $subfieldName = $params->{subfield};
my @values = @{ $params->{values} };
my $dont_erase = $params->{dont_erase};
+ my $field_numbers = $params->{field_numbers} // [];
my $i = 0;
- if ( my @fields = $record->field( $fieldName ) ) {
+ 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;
my $record = $params->{record};
my $fieldName = $params->{field};
my $subfieldName = $params->{subfield};
- my $n = $params->{n};
+ my $field_numbers = $params->{field_numbers} // [];
- if ( not $subfieldName or $subfieldName eq '' ) {
- _read_field({ record => $record, field => $fieldName, n => $n });
+ 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, n => $n });
+ _read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
}
}
my ( $params ) = @_;
my $record = $params->{record};
my $fieldName = $params->{field};
- my $n = $params->{n};
+ my $field_numbers = $params->{field_numbers} // [];
my @fields = $record->field( $fieldName );
if $fieldName < 10;
my @values;
- if ( $n ) {
- if ( $n <= scalar( @fields ) ) {
- for my $sf ( $fields[$n - 1]->subfields ) {
- push @values, $sf->[1];
+ 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 {
my $record = $params->{record};
my $fieldName = $params->{field};
my $subfieldName = $params->{subfield};
- my $n = $params->{n};
+ my $field_numbers = $params->{field_numbers} // [];
my @fields = $record->field( $fieldName );
push( @values, @sf );
}
- return $n
- ? $values[$n-1]
- : @values;
+ if ( @values and @$field_numbers ) {
+ @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
+ }
+
+ return @values;
}
=head2 field_exists
- $bool = field_exists( $record, $fieldName[, $subfieldName ]);
+ @field_numbers = field_exists( $record, $fieldName[, $subfieldName ]);
- Returns true if the field exits, false otherwise.
+ Returns the field numbers or an empty array.
=cut
if ( ! $record ) { return; }
- my $return = 0;
- if ( $fieldName && $subfieldName ) {
- $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
- } elsif ( $fieldName ) {
- $return = $record->field( $fieldName ) && 1;
+ 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 $return;
+ return \@field_numbers;
}
=head2 field_equals
- $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
+ $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'
- If $n is passed, the Nth field of a repeatable series will be used for comparison.
- Set $n to 1 or leave empty for a non-repeatable field.
-
=cut
sub field_equals {
my $value = $params->{value};
my $fieldName = $params->{field};
my $subfieldName = $params->{subfield};
- my $regex = $params->{regex};
- my $n = $params->{n};
- $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
+ my $is_regex = $params->{is_regex};
if ( ! $record ) { return; }
- my @field_values = read_field({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
- my $field_value = $field_values[$n-1];
+ 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;
+ }
- if ( $regex ) {
- return $field_value =~ m/$value/;
- } else {
- return $field_value eq $value;
+ 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
my $toFieldName = $params->{to_field};
my $toSubfieldName = $params->{to_subfield};
my $regex = $params->{regex};
- my $n = $params->{n};
-
- if ( not $fromSubfieldName or $fromSubfieldName eq ''
- or not $toSubfieldName or $toSubfieldName eq ''
- ) {
- _move_field({
- record => $record,
- from_field => $fromFieldName,
- to_field => $toFieldName,
- regex => $regex,
- n => $n,
- });
+ 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 {
- _move_subfield({
- record => $record,
- from_field => $fromFieldName,
- from_subfield => $fromSubfieldName,
- to_field => $toFieldName,
- to_subfield => $toSubfieldName,
- regex => $regex,
- n => $n,
- });
+ _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',
+ }
+ );
}
}
-sub _move_field {
- my ( $params ) = @_;
- my $record = $params->{record};
- my $fromFieldName = $params->{from_field};
- my $toFieldName = $params->{to_field};
- my $regex = $params->{regex};
- my $n = $params->{n};
- _copy_move_field({
- record => $record,
- from_field => $fromFieldName,
- to_field => $toFieldName,
- regex => $regex,
- n => $n,
- action => 'move',
- });
-}
-
-sub _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 $n = $params->{n};
-
- # Copy
- my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
- @values = ( $values[$n-1] ) if $n;
- _modify_values({ values => \@values, regex => $regex });
- _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => 1, values => \@values });
-
- # And delete
- _delete_subfield({
- record => $record,
- field => $fromFieldName,
- subfield => $fromSubfieldName,
- n => $n,
- });
-}
-
=head2 _delete_field
_delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
my $record = $params->{record};
my $fieldName = $params->{field};
my $subfieldName = $params->{subfield};
- my $n = $params->{n};
+ my $field_numbers = $params->{field_numbers} // [];
- if ( not $subfieldName or $subfieldName eq '' ) {
- _delete_field({ record => $record, field => $fieldName, n => $n });
+ 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, n => $n });
+ _delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
}
}
my ( $params ) = @_;
my $record = $params->{record};
my $fieldName = $params->{field};
- my $n = $params->{n};
+ my $field_numbers = $params->{field_numbers} // [];
my @fields = $record->field( $fieldName );
- @fields = ( $fields[$n-1] ) if ( $n );
+ if ( @$field_numbers ) {
+ @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
+ }
foreach my $field ( @fields ) {
$record->delete_field( $field );
}
my $record = $params->{record};
my $fieldName = $params->{field};
my $subfieldName = $params->{subfield};
- my $n = $params->{n};
+ my $field_numbers = $params->{field_numbers} // [];
my @fields = $record->field( $fieldName );
- @fields = ( $fields[$n-1] ) if ( $n );
+ 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();
}
}
my $fromFieldName = $params->{from_field};
my $toFieldName = $params->{to_field};
my $regex = $params->{regex};
- my $n = $params->{n};
+ my $field_numbers = $params->{field_numbers} // [];
my $action = $params->{action} || 'copy';
- my @fields = $record->field( $fromFieldName );
- if ( $n and $n <= scalar( @fields ) ) {
- @fields = ( $fields[$n - 1] );
+ my @from_fields = $record->field( $fromFieldName );
+ if ( @$field_numbers ) {
+ @from_fields = map { $_ <= @from_fields ? $from_fields[ $_ - 1 ] : () } @$field_numbers;
}
- for my $field ( @fields ) {
- my $new_field = $field->clone;
+ 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 ) {
$new_field->update( $subfield->[0], $value );
}
}
- $record->append_fields( $new_field );
- $record->delete_field( $field )
- if $action eq 'move';
+ 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,
+ });
}
}
my $regex = $params->{regex};
if ( $regex and $regex->{search} ) {
+ my $replace = $regex->{replace};
+ $replace =~ s/"/\\"/g; # Protection from embedded code
+ $replace = '"' . $replace . '"'; # Put in a string for /ee
$regex->{modifiers} //= q||;
my @available_modifiers = qw( i g );
my $modifiers = q||;
}
foreach my $value ( @$values ) {
if ( $modifiers =~ m/^(ig|gi)$/ ) {
- $value =~ s/$regex->{search}/$regex->{replace}/ig;
+ $value =~ s/$regex->{search}/$replace/igee;
}
elsif ( $modifiers eq 'i' ) {
- $value =~ s/$regex->{search}/$regex->{replace}/i;
+ $value =~ s/$regex->{search}/$replace/iee;
}
elsif ( $modifiers eq 'g' ) {
- $value =~ s/$regex->{search}/$regex->{replace}/g;
+ $value =~ s/$regex->{search}/$replace/gee;
}
else {
- $value =~ s/$regex->{search}/$regex->{replace}/;
+ $value =~ s/$regex->{search}/$replace/ee;
}
}
}
projects / srvgit / blobdiff