1 package Koha::SimpleMARC;
3 # Copyright 2009 Kyle M. Hall <kyle.m.hall@gmail.com>
5 # Koha is free software; you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
10 # Koha is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
21 our (@ISA, @EXPORT_OK);
24 our @ISA = qw(Exporter);
31 copy_and_replace_field
41 SimpleMARC - Perl module for making simple MARC record alterations.
49 SimpleMARC is designed to make writing scripts
50 to modify MARC records simple and easy.
52 Every function in the modules requires a
53 MARC::Record object as its first parameter.
57 Kyle Hall <lt>kyle.m.hall@gmail.com<gt>
59 =head1 COPYRIGHT AND LICENSE
61 Copyright (C) 2009 by Kyle Hall
63 This library is free software; you can redistribute it and/or modify
64 it under the same terms as Perl itself, either Perl version 5.8.7 or,
65 at your option, any later version of Perl 5 you may have available.
71 copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex[, $n ] ] );
73 Copies a value from one field to another. If a regular expression ( $regex ) is supplied,
74 the value will be transformed by the given regex before being copied into the new field.
75 Example: $regex = { search => 'Old Text', replace => 'Replacement Text', modifiers => 'g' };
77 If $n is passed, copy_field will only copy the Nth field of the list of fields.
78 E.g. $n = 1 will only use the first field's value, $n = 2 will use only the 2nd field's value.
84 my $record = $params->{record};
85 my $fromFieldName = $params->{from_field};
86 my $fromSubfieldName = $params->{from_subfield};
87 my $toFieldName = $params->{to_field};
88 my $toSubfieldName = $params->{to_subfield};
89 my $regex = $params->{regex};
90 my $field_numbers = $params->{field_numbers} // [];
92 if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
95 if ( not $fromSubfieldName
96 or $fromSubfieldName eq ''
97 or not $toSubfieldName
98 or $toSubfieldName eq '' ) {
101 from_field => $fromFieldName,
102 to_field => $toFieldName,
104 field_numbers => $field_numbers,
111 from_field => $fromFieldName,
112 from_subfield => $fromSubfieldName,
113 to_field => $toFieldName,
114 to_subfield => $toSubfieldName,
116 field_numbers => $field_numbers,
123 sub copy_and_replace_field {
125 my $record = $params->{record};
126 my $fromFieldName = $params->{from_field};
127 my $fromSubfieldName = $params->{from_subfield};
128 my $toFieldName = $params->{to_field};
129 my $toSubfieldName = $params->{to_subfield};
130 my $regex = $params->{regex};
131 my $field_numbers = $params->{field_numbers} // [];
133 if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
136 if ( !defined $fromSubfieldName or $fromSubfieldName eq ''
137 or !defined $toSubfieldName or $toSubfieldName eq ''
141 from_field => $fromFieldName,
142 to_field => $toFieldName,
144 field_numbers => $field_numbers,
151 from_field => $fromFieldName,
152 from_subfield => $fromSubfieldName,
153 to_field => $toFieldName,
154 to_subfield => $toSubfieldName,
156 field_numbers => $field_numbers,
165 my $record = $params->{record};
166 my $fieldName = $params->{field};
167 my $subfieldName = $params->{subfield};
168 my @values = @{ $params->{values} };
169 my $field_numbers = $params->{field_numbers} // [];
171 if ( ! ( $record && $fieldName ) ) { return; }
173 if ( not defined $subfieldName or $subfieldName eq '' ) {
174 # FIXME I'm not sure the actual implementation is correct.
175 die "This action is not implemented yet";
176 #_update_field({ record => $record, field => $fieldName, values => \@values });
178 _update_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, values => \@values, field_numbers => $field_numbers });
187 subfield => $subfieldName,
189 field_numbers => $field_numbers,
192 Adds a new field/subfield with supplied value(s).
193 This function always add a new field as opposed to 'update_field' which will
194 either update if field exists and add if it does not.
201 my $record = $params->{record};
202 my $fieldName = $params->{field};
203 my $subfieldName = $params->{subfield};
204 my @values = @{ $params->{values} };
205 my $field_numbers = $params->{field_numbers} // [];
207 if ( ! ( $record && $fieldName ) ) { return; }
208 if ( $fieldName > 10 ) {
209 foreach my $value ( @values ) {
210 my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $value );
211 $record->append_fields( $field );
214 foreach my $value ( @values ) {
215 my $field = MARC::Field->new( $fieldName, $value );
216 $record->append_fields( $field );
223 my $record = $params->{record};
224 my $fieldName = $params->{field};
225 my @values = @{ $params->{values} };
228 if ( my @fields = $record->field( $fieldName ) ) {
229 @values = ($values[0]) x scalar( @fields )
231 foreach my $field ( @fields ) {
232 $field->update( $values[$i++] );
235 ## Field does not exists, create it
236 if ( $fieldName < 10 ) {
237 foreach my $value ( @values ) {
238 my $field = MARC::Field->new( $fieldName, $value );
239 $record->append_fields( $field );
242 warn "Invalid operation, trying to add a new field without subfield";
247 sub _update_subfield {
249 my $record = $params->{record};
250 my $fieldName = $params->{field};
251 my $subfieldName = $params->{subfield};
252 my @values = @{ $params->{values} };
253 my $dont_erase = $params->{dont_erase};
254 my $field_numbers = $params->{field_numbers} // [];
257 my @fields = $record->field( $fieldName );
259 if ( @$field_numbers ) {
260 @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
264 unless ( $dont_erase ) {
265 @values = ($values[0]) x scalar( @fields )
267 foreach my $field ( @fields ) {
268 $field->update( "$subfieldName" => $values[$i++] );
271 if ( $i <= scalar ( @values ) - 1 ) {
272 foreach my $field ( @fields ) {
273 foreach my $j ( $i .. scalar( @values ) - 1) {
274 $field->add_subfields( "$subfieldName" => $values[$j] );
279 ## Field does not exist, create it.
280 foreach my $value ( @values ) {
281 my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
282 $record->append_fields( $field );
289 my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
291 Returns an array of field values for the given field and subfield
293 If $n is given, it will return only the $nth value of the array.
294 E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
300 my $record = $params->{record};
301 my $fieldName = $params->{field};
302 my $subfieldName = $params->{subfield};
303 my $field_numbers = $params->{field_numbers} // [];
305 if ( not defined $subfieldName or $subfieldName eq '' ) {
306 _read_field({ record => $record, field => $fieldName, field_numbers => $field_numbers });
308 _read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
314 my $record = $params->{record};
315 my $fieldName = $params->{field};
316 my $field_numbers = $params->{field_numbers} // [];
318 my @fields = $record->field( $fieldName );
320 return unless @fields;
322 return map { $_->data() } @fields
326 if ( @$field_numbers ) {
327 for my $field_number ( @$field_numbers ) {
328 if ( $field_number <= scalar( @fields ) ) {
329 for my $sf ( $fields[$field_number - 1]->subfields ) {
330 push @values, $sf->[1];
335 foreach my $field ( @fields ) {
336 for my $sf ( $field->subfields ) {
337 push @values, $sf->[1];
347 my $record = $params->{record};
348 my $fieldName = $params->{field};
349 my $subfieldName = $params->{subfield};
350 my $field_numbers = $params->{field_numbers} // [];
352 my @fields = $record->field( $fieldName );
354 return unless @fields;
357 foreach my $field ( @fields ) {
358 my @sf = $field->subfield( $subfieldName );
359 push( @values, @sf );
362 if ( @values and @$field_numbers ) {
363 @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
371 @field_numbers = field_exists( $record, $fieldName[, $subfieldName ]);
373 Returns the field numbers or an empty array.
379 my $record = $params->{record};
380 my $fieldName = $params->{field};
381 my $subfieldName = $params->{subfield};
383 if ( ! $record ) { return; }
385 my @field_numbers = ();
386 my $current_field_number = 1;
387 for my $field ( $record->field( $fieldName ) ) {
388 if ( $subfieldName ) {
389 push @field_numbers, $current_field_number
390 if $field->subfield( $subfieldName );
392 push @field_numbers, $current_field_number;
394 $current_field_number++;
397 return \@field_numbers;
402 $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex ] ]);
404 Returns true if the field equals the given value, false otherwise.
406 If a regular expression ( $regex ) is supplied, the value will be compared using
407 the given regex. Example: $regex = 'sought_text'
413 my $record = $params->{record};
414 my $value = $params->{value};
415 my $fieldName = $params->{field};
416 my $subfieldName = $params->{subfield};
417 my $is_regex = $params->{is_regex};
419 if ( ! $record ) { return; }
421 my @field_numbers = ();
422 my $current_field_number = 1;
423 FIELDS: for my $field ( $record->field( $fieldName ) ) {
425 if ( $field->is_control_field ) {
426 push @subfield_values, $field->data;
430 ? $field->subfield($subfieldName)
431 : map { $_->[1] } $field->subfields;
434 SUBFIELDS: for my $subfield_value ( @subfield_values ) {
437 $is_regex and $subfield_value =~ m/$value/
439 $subfield_value eq $value
442 push @field_numbers, $current_field_number;
446 $current_field_number++;
449 return \@field_numbers;
454 move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
456 Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
457 the value will be transformed by the given regex before being moved into the new field.
458 Example: $regex = 's/Old Text/Replacement Text/'
460 If $n is passed, only the Nth field will be moved. $n = 1
461 will move the first repeatable field, $n = 3 will move the third.
467 my $record = $params->{record};
468 my $fromFieldName = $params->{from_field};
469 my $fromSubfieldName = $params->{from_subfield};
470 my $toFieldName = $params->{to_field};
471 my $toSubfieldName = $params->{to_subfield};
472 my $regex = $params->{regex};
473 my $field_numbers = $params->{field_numbers} // [];
475 if ( !defined $fromSubfieldName
476 or $fromSubfieldName eq ''
477 or !defined $toSubfieldName
478 or $toSubfieldName eq '' ) {
481 from_field => $fromFieldName,
482 to_field => $toFieldName,
484 field_numbers => $field_numbers,
491 from_field => $fromFieldName,
492 from_subfield => $fromSubfieldName,
493 to_field => $toFieldName,
494 to_subfield => $toSubfieldName,
496 field_numbers => $field_numbers,
505 _delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
507 Deletes the given field.
509 If $n is passed, only the Nth field will be deleted. $n = 1
510 will delete the first repeatable field, $n = 3 will delete the third.
516 my $record = $params->{record};
517 my $fieldName = $params->{field};
518 my $subfieldName = $params->{subfield};
519 my $field_numbers = $params->{field_numbers} // [];
521 if ( !defined $subfieldName or $subfieldName eq '' ) {
522 _delete_field({ record => $record, field => $fieldName, field_numbers => $field_numbers });
524 _delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
530 my $record = $params->{record};
531 my $fieldName = $params->{field};
532 my $field_numbers = $params->{field_numbers} // [];
534 my @fields = $record->field( $fieldName );
536 if ( @$field_numbers ) {
537 @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
539 foreach my $field ( @fields ) {
540 $record->delete_field( $field );
544 sub _delete_subfield {
546 my $record = $params->{record};
547 my $fieldName = $params->{field};
548 my $subfieldName = $params->{subfield};
549 my $field_numbers = $params->{field_numbers} // [];
551 my @fields = $record->field( $fieldName );
553 if ( @$field_numbers ) {
554 @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
557 foreach my $field ( @fields ) {
558 $field->delete_subfield( code => $subfieldName );
559 $record->delete_field( $field ) unless $field->subfields();
564 sub _copy_move_field {
566 my $record = $params->{record};
567 my $fromFieldName = $params->{from_field};
568 my $toFieldName = $params->{to_field};
569 my $regex = $params->{regex};
570 my $field_numbers = $params->{field_numbers} // [];
571 my $action = $params->{action} || 'copy';
573 my @from_fields = $record->field( $fromFieldName );
574 if ( @$field_numbers ) {
575 @from_fields = map { $_ <= @from_fields ? $from_fields[ $_ - 1 ] : () } @$field_numbers;
579 for my $from_field ( @from_fields ) {
580 my $new_field = $from_field->clone;
581 $new_field->{_tag} = $toFieldName; # Should be replaced by set_tag, introduced by MARC::Field 2.0.4
582 if ( $regex and $regex->{search} ) {
583 for my $subfield ( $new_field->subfields ) {
584 my $value = $subfield->[1];
585 ( $value ) = _modify_values({ values => [ $value ], regex => $regex });
586 $new_field->update( $subfield->[0], $value );
589 if ( $action eq 'move' ) {
590 $record->delete_field( $from_field )
592 elsif ( $action eq 'replace' ) {
593 my @to_fields = $record->field( $toFieldName );
595 $record->delete_field( $to_fields[0] );
598 push @new_fields, $new_field;
600 $record->append_fields( @new_fields );
603 sub _copy_move_subfield {
605 my $record = $params->{record};
606 my $fromFieldName = $params->{from_field};
607 my $fromSubfieldName = $params->{from_subfield};
608 my $toFieldName = $params->{to_field};
609 my $toSubfieldName = $params->{to_subfield};
610 my $regex = $params->{regex};
611 my $field_numbers = $params->{field_numbers} // [];
612 my $action = $params->{action} || 'copy';
614 my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
615 if ( @$field_numbers ) {
616 @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
618 _modify_values({ values => \@values, regex => $regex });
619 my $dont_erase = $action eq 'copy' ? 1 : 0;
620 _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values, dont_erase => $dont_erase });
622 # And delete if it's a move
623 if ( $action eq 'move' ) {
626 field => $fromFieldName,
627 subfield => $fromSubfieldName,
628 field_numbers => $field_numbers,
635 my $values = $params->{values};
636 my $regex = $params->{regex};
638 if ( $regex and $regex->{search} ) {
639 $regex->{modifiers} //= q||;
640 my @available_modifiers = qw( i g );
642 for my $modifier ( split //, $regex->{modifiers} ) {
643 $modifiers .= $modifier
644 if grep {/$modifier/} @available_modifiers;
646 foreach my $value ( @$values ) {
647 if ( $modifiers =~ m/^(ig|gi)$/ ) {
648 $value =~ s/$regex->{search}/$regex->{replace}/ig;
650 elsif ( $modifiers eq 'i' ) {
651 $value =~ s/$regex->{search}/$regex->{replace}/i;
653 elsif ( $modifiers eq 'g' ) {
654 $value =~ s/$regex->{search}/$regex->{replace}/g;
657 $value =~ s/$regex->{search}/$regex->{replace}/;