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 use constant LAST_TRANSACTION_FIELD => q/005/; # MARC21/UNIMARC
23 our (@ISA, @EXPORT_OK);
26 our @ISA = qw(Exporter);
33 copy_and_replace_field
38 update_last_transaction_time
44 SimpleMARC - Perl module for making simple MARC record alterations.
52 SimpleMARC is designed to make writing scripts
53 to modify MARC records simple and easy.
55 Every function in the modules requires a
56 MARC::Record object as its first parameter.
60 Kyle Hall <lt>kyle.m.hall@gmail.com<gt>
62 =head1 COPYRIGHT AND LICENSE
64 Copyright (C) 2009 by Kyle Hall
66 This library is free software; you can redistribute it and/or modify
67 it under the same terms as Perl itself, either Perl version 5.8.7 or,
68 at your option, any later version of Perl 5 you may have available.
74 copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex[, $n ] ] );
76 Copies a value from one field to another. If a regular expression ( $regex ) is supplied,
77 the value will be transformed by the given regex before being copied into the new field.
78 Example: $regex = { search => 'Old Text', replace => 'Replacement Text', modifiers => 'g' };
80 If $n is passed, copy_field will only copy the Nth field of the list of fields.
81 E.g. $n = 1 will only use the first field's value, $n = 2 will use only the 2nd field's value.
87 my $record = $params->{record};
88 my $fromFieldName = $params->{from_field};
89 my $fromSubfieldName = $params->{from_subfield};
90 my $toFieldName = $params->{to_field};
91 my $toSubfieldName = $params->{to_subfield};
92 my $regex = $params->{regex};
93 my $field_numbers = $params->{field_numbers} // [];
95 if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
98 if ( not defined $fromSubfieldName
99 or $fromSubfieldName eq ''
100 or not defined $toSubfieldName
101 or $toSubfieldName eq '' ) {
104 from_field => $fromFieldName,
105 to_field => $toFieldName,
107 field_numbers => $field_numbers,
114 from_field => $fromFieldName,
115 from_subfield => $fromSubfieldName,
116 to_field => $toFieldName,
117 to_subfield => $toSubfieldName,
119 field_numbers => $field_numbers,
126 sub copy_and_replace_field {
128 my $record = $params->{record};
129 my $fromFieldName = $params->{from_field};
130 my $fromSubfieldName = $params->{from_subfield};
131 my $toFieldName = $params->{to_field};
132 my $toSubfieldName = $params->{to_subfield};
133 my $regex = $params->{regex};
134 my $field_numbers = $params->{field_numbers} // [];
136 if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
139 if ( !defined $fromSubfieldName or $fromSubfieldName eq ''
140 or !defined $toSubfieldName or $toSubfieldName eq ''
144 from_field => $fromFieldName,
145 to_field => $toFieldName,
147 field_numbers => $field_numbers,
154 from_field => $fromFieldName,
155 from_subfield => $fromSubfieldName,
156 to_field => $toFieldName,
157 to_subfield => $toSubfieldName,
159 field_numbers => $field_numbers,
168 my $record = $params->{record};
169 my $fieldName = $params->{field};
170 my $subfieldName = $params->{subfield};
171 my @values = @{ $params->{values} };
172 my $field_numbers = $params->{field_numbers} // [];
174 if ( ! ( $record && $fieldName ) ) { return; }
176 if ( not defined $subfieldName or $subfieldName eq '' ) {
177 # FIXME I'm not sure the actual implementation is correct.
178 die "This action is not implemented yet";
179 #_update_field({ record => $record, field => $fieldName, values => \@values });
181 _update_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, values => \@values, field_numbers => $field_numbers });
190 subfield => $subfieldName,
192 field_numbers => $field_numbers,
195 Adds a new field/subfield with supplied value(s).
196 This function always add a new field as opposed to 'update_field' which will
197 either update if field exists and add if it does not.
204 my $record = $params->{record};
205 my $fieldName = $params->{field};
206 my $subfieldName = $params->{subfield};
207 my @values = @{ $params->{values} };
208 my $field_numbers = $params->{field_numbers} // [];
210 if ( ! ( $record && $fieldName ) ) { return; }
211 if ( $fieldName > 10 ) {
212 foreach my $value ( @values ) {
213 my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $value );
214 $record->insert_fields_ordered( $field );
217 foreach my $value ( @values ) {
218 my $field = MARC::Field->new( $fieldName, $value );
219 $record->insert_fields_ordered( $field );
226 my $record = $params->{record};
227 my $fieldName = $params->{field};
228 my @values = @{ $params->{values} };
231 if ( my @fields = $record->field( $fieldName ) ) {
232 @values = ($values[0]) x scalar( @fields )
234 foreach my $field ( @fields ) {
235 $field->update( $values[$i++] );
238 ## Field does not exists, create it
239 if ( $fieldName < 10 ) {
240 foreach my $value ( @values ) {
241 my $field = MARC::Field->new( $fieldName, $value );
242 $record->insert_fields_ordered( $field );
245 warn "Invalid operation, trying to add a new field without subfield";
250 sub _update_subfield {
252 my $record = $params->{record};
253 my $fieldName = $params->{field};
254 my $subfieldName = $params->{subfield};
255 my @values = @{ $params->{values} };
256 my $dont_erase = $params->{dont_erase};
257 my $field_numbers = $params->{field_numbers} // [];
260 my @fields = $record->field( $fieldName );
262 if ( @$field_numbers ) {
263 @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
267 unless ( $dont_erase ) {
268 @values = ($values[0]) x scalar( @fields )
270 foreach my $field ( @fields ) {
271 $field->update( "$subfieldName" => $values[$i++] );
274 if ( $i <= scalar ( @values ) - 1 ) {
275 foreach my $field ( @fields ) {
276 foreach my $j ( $i .. scalar( @values ) - 1) {
277 $field->add_subfields( "$subfieldName" => $values[$j] );
282 ## Field does not exist, create it.
283 foreach my $value ( @values ) {
284 my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
285 $record->insert_fields_ordered( $field );
292 my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
294 Returns an array of field values for the given field and subfield
296 If $n is given, it will return only the $nth value of the array.
297 E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
303 my $record = $params->{record};
304 my $fieldName = $params->{field};
305 my $subfieldName = $params->{subfield};
306 my $field_numbers = $params->{field_numbers} // [];
308 if ( not defined $subfieldName or $subfieldName eq '' ) {
309 _read_field({ record => $record, field => $fieldName, field_numbers => $field_numbers });
311 _read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
317 my $record = $params->{record};
318 my $fieldName = $params->{field};
319 my $field_numbers = $params->{field_numbers} // [];
321 my @fields = $record->field( $fieldName );
323 return unless @fields;
325 return map { $_->data() } @fields
329 if ( @$field_numbers ) {
330 for my $field_number ( @$field_numbers ) {
331 if ( $field_number <= scalar( @fields ) ) {
332 for my $sf ( $fields[$field_number - 1]->subfields ) {
333 push @values, $sf->[1];
338 foreach my $field ( @fields ) {
339 for my $sf ( $field->subfields ) {
340 push @values, $sf->[1];
350 my $record = $params->{record};
351 my $fieldName = $params->{field};
352 my $subfieldName = $params->{subfield};
353 my $field_numbers = $params->{field_numbers} // [];
355 my @fields = $record->field( $fieldName );
357 return unless @fields;
360 foreach my $field ( @fields ) {
361 my @sf = $field->subfield( $subfieldName );
362 push( @values, @sf );
365 if ( @values and @$field_numbers ) {
366 @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
374 @field_numbers = field_exists( $record, $fieldName[, $subfieldName ]);
376 Returns the field numbers or an empty array.
382 my $record = $params->{record};
383 my $fieldName = $params->{field};
384 my $subfieldName = $params->{subfield};
386 if ( ! $record ) { return; }
388 my @field_numbers = ();
389 my $current_field_number = 1;
390 for my $field ( $record->field( $fieldName ) ) {
391 if ( $subfieldName ) {
392 push @field_numbers, $current_field_number
393 if $field->subfield( $subfieldName );
395 push @field_numbers, $current_field_number;
397 $current_field_number++;
400 return \@field_numbers;
405 $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex ] ]);
407 Returns true if the field equals the given value, false otherwise.
409 If a regular expression ( $regex ) is supplied, the value will be compared using
410 the given regex. Example: $regex = 'sought_text'
416 my $record = $params->{record};
417 my $value = $params->{value};
418 my $fieldName = $params->{field};
419 my $subfieldName = $params->{subfield};
420 my $is_regex = $params->{is_regex};
422 if ( ! $record ) { return; }
424 my @field_numbers = ();
425 my $current_field_number = 1;
426 FIELDS: for my $field ( $record->field( $fieldName ) ) {
428 if ( $field->is_control_field ) {
429 push @subfield_values, $field->data;
433 ? $field->subfield($subfieldName)
434 : map { $_->[1] } $field->subfields;
437 SUBFIELDS: for my $subfield_value ( @subfield_values ) {
440 $is_regex and $subfield_value =~ m/$value/
442 $subfield_value eq $value
445 push @field_numbers, $current_field_number;
449 $current_field_number++;
452 return \@field_numbers;
457 move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
459 Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
460 the value will be transformed by the given regex before being moved into the new field.
461 Example: $regex = 's/Old Text/Replacement Text/'
463 If $n is passed, only the Nth field will be moved. $n = 1
464 will move the first repeatable field, $n = 3 will move the third.
470 my $record = $params->{record};
471 my $fromFieldName = $params->{from_field};
472 my $fromSubfieldName = $params->{from_subfield};
473 my $toFieldName = $params->{to_field};
474 my $toSubfieldName = $params->{to_subfield};
475 my $regex = $params->{regex};
476 my $field_numbers = $params->{field_numbers} // [];
478 if ( !defined $fromSubfieldName
479 or $fromSubfieldName eq ''
480 or !defined $toSubfieldName
481 or $toSubfieldName eq '' ) {
484 from_field => $fromFieldName,
485 to_field => $toFieldName,
487 field_numbers => $field_numbers,
494 from_field => $fromFieldName,
495 from_subfield => $fromSubfieldName,
496 to_field => $toFieldName,
497 to_subfield => $toSubfieldName,
499 field_numbers => $field_numbers,
508 _delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
510 Deletes the given field.
512 If $n is passed, only the Nth field will be deleted. $n = 1
513 will delete the first repeatable field, $n = 3 will delete the third.
519 my $record = $params->{record};
520 my $fieldName = $params->{field};
521 my $subfieldName = $params->{subfield};
522 my $field_numbers = $params->{field_numbers} // [];
524 if ( !defined $subfieldName or $subfieldName eq '' ) {
525 _delete_field({ record => $record, field => $fieldName, field_numbers => $field_numbers });
527 _delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
531 =head3 update_last_transaction_time
533 update_last_transaction_time( { record => $record } );
535 Inserts or updates field for last transaction (005)
539 sub update_last_transaction_time {
541 my $record = $params->{record};
543 my @localtime = (localtime)[ 5, 4, 3, 2, 1, 0 ];
544 $localtime[0] += 1900; # add century
545 $localtime[1]++; # month 1-based
547 my $value = sprintf( "%4d%02d%02d%02d%02d%04.1f", @localtime );
549 if ( $field = $record->field(LAST_TRANSACTION_FIELD) ) {
550 $field->update($value);
552 $record->insert_fields_ordered(
553 MARC::Field->new( LAST_TRANSACTION_FIELD, $value ),
560 my $record = $params->{record};
561 my $fieldName = $params->{field};
562 my $field_numbers = $params->{field_numbers} // [];
564 my @fields = $record->field( $fieldName );
566 if ( @$field_numbers ) {
567 @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
569 foreach my $field ( @fields ) {
570 $record->delete_field( $field );
574 sub _delete_subfield {
576 my $record = $params->{record};
577 my $fieldName = $params->{field};
578 my $subfieldName = $params->{subfield};
579 my $field_numbers = $params->{field_numbers} // [];
581 my @fields = $record->field( $fieldName );
583 if ( @$field_numbers ) {
584 @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
587 foreach my $field ( @fields ) {
588 $field->delete_subfield( code => $subfieldName );
589 $record->delete_field( $field ) unless $field->subfields();
594 sub _copy_move_field {
596 my $record = $params->{record};
597 my $fromFieldName = $params->{from_field};
598 my $toFieldName = $params->{to_field};
599 my $regex = $params->{regex};
600 my $field_numbers = $params->{field_numbers} // [];
601 my $action = $params->{action} || 'copy';
603 my @from_fields = $record->field( $fromFieldName );
604 if ( @$field_numbers ) {
605 @from_fields = map { $_ <= @from_fields ? $from_fields[ $_ - 1 ] : () } @$field_numbers;
609 for my $from_field ( @from_fields ) {
610 my $new_field = $from_field->clone;
611 $new_field->{_tag} = $toFieldName; # Should be replaced by set_tag, introduced by MARC::Field 2.0.4
612 if ( $regex and $regex->{search} ) {
613 for my $subfield ( $new_field->subfields ) {
614 my $value = $subfield->[1];
615 ( $value ) = _modify_values({ values => [ $value ], regex => $regex });
616 $new_field->update( $subfield->[0], $value );
619 if ( $action eq 'move' ) {
620 $record->delete_field( $from_field )
622 elsif ( $action eq 'replace' ) {
623 my @to_fields = $record->field( $toFieldName );
625 $record->delete_field( $to_fields[0] );
628 unshift @new_fields, $new_field;
630 $record->insert_fields_ordered( @new_fields );
633 sub _copy_move_subfield {
635 my $record = $params->{record};
636 my $fromFieldName = $params->{from_field};
637 my $fromSubfieldName = $params->{from_subfield};
638 my $toFieldName = $params->{to_field};
639 my $toSubfieldName = $params->{to_subfield};
640 my $regex = $params->{regex};
641 my $field_numbers = $params->{field_numbers} // [];
642 my $action = $params->{action} || 'copy';
644 my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
645 if ( @$field_numbers ) {
646 @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
648 _modify_values({ values => \@values, regex => $regex });
649 my $dont_erase = $action eq 'copy' ? 1 : 0;
650 _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values, dont_erase => $dont_erase });
652 # And delete if it's a move
653 if ( $action eq 'move' ) {
656 field => $fromFieldName,
657 subfield => $fromSubfieldName,
658 field_numbers => $field_numbers,
665 my $values = $params->{values};
666 my $regex = $params->{regex};
668 if ( $regex and $regex->{search} ) {
669 my $replace = $regex->{replace};
670 $replace =~ s/"/\\"/g; # Protection from embedded code
671 $replace = '"' . $replace . '"'; # Put in a string for /ee
672 $regex->{modifiers} //= q||;
673 my @available_modifiers = qw( i g );
675 for my $modifier ( split //, $regex->{modifiers} ) {
676 $modifiers .= $modifier
677 if grep {/$modifier/} @available_modifiers;
679 foreach my $value ( @$values ) {
680 if ( $modifiers =~ m/^(ig|gi)$/ ) {
681 $value =~ s/$regex->{search}/$replace/igee;
683 elsif ( $modifiers eq 'i' ) {
684 $value =~ s/$regex->{search}/$replace/iee;
686 elsif ( $modifiers eq 'g' ) {
687 $value =~ s/$regex->{search}/$replace/gee;
690 $value =~ s/$regex->{search}/$replace/ee;