1 package Koha::SimpleMARC;
3 # Copyright 2009 Kyle M. Hall <kyle.m.hall@gmail.com>
11 our @ISA = qw(Exporter);
12 our %EXPORT_TAGS = ( 'all' => [ qw(
16 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
28 our $VERSION = '0.01';
34 SimpleMARC - Perl module for making simple MARC record alterations.
42 SimpleMARC is designed to make writing scripts
43 to modify MARC records simple and easy.
45 Every function in the modules requires a
46 MARC::Record object as its first parameter.
50 Kyle Hall <lt>kyle.m.hall@gmail.com<gt>
52 =head1 COPYRIGHT AND LICENSE
54 Copyright (C) 2009 by Kyle Hall
56 This library is free software; you can redistribute it and/or modify
57 it under the same terms as Perl itself, either Perl version 5.8.7 or,
58 at your option, any later version of Perl 5 you may have available.
64 copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex[, $n ] ] );
66 Copies a value from one field to another. If a regular expression ( $regex ) is supplied,
67 the value will be transformed by the given regex before being copied into the new field.
68 Example: $regex = { search => 'Old Text', replace => 'Replacement Text', modifiers => 'g' };
70 If $n is passed, copy_field will only copy the Nth field of the list of fields.
71 E.g. $n = 1 will only use the first field's value, $n = 2 will use only the 2nd field's value.
77 my $record = $params->{record};
78 my $fromFieldName = $params->{from_field};
79 my $fromSubfieldName = $params->{from_subfield};
80 my $toFieldName = $params->{to_field};
81 my $toSubfieldName = $params->{to_subfield};
82 my $regex = $params->{regex};
85 if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
88 if ( not $fromSubfieldName or $fromSubfieldName eq ''
89 or not $toSubfieldName or $toSubfieldName eq ''
93 from_field => $fromFieldName,
94 to_field => $toFieldName,
101 from_field => $fromFieldName,
102 from_subfield => $fromSubfieldName,
103 to_field => $toFieldName,
104 to_subfield => $toSubfieldName,
114 my $record = $params->{record};
115 my $fromFieldName = $params->{from_field};
116 my $toFieldName = $params->{to_field};
117 my $regex = $params->{regex};
118 my $n = $params->{n};
122 from_field => $fromFieldName,
123 to_field => $toFieldName,
131 my $record = $params->{record};
132 my $fromFieldName = $params->{from_field};
133 my $fromSubfieldName = $params->{from_subfield};
134 my $toFieldName = $params->{to_field};
135 my $toSubfieldName = $params->{to_subfield};
136 my $regex = $params->{regex};
137 my $n = $params->{n};
139 my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
140 @values = ( $values[$n-1] ) if ( $n );
141 _modify_values({ values => \@values, regex => $regex });
143 update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values });
148 my $record = $params->{record};
149 my $fieldName = $params->{field};
150 my $subfieldName = $params->{subfield};
151 my @values = @{ $params->{values} };
153 if ( ! ( $record && $fieldName ) ) { return; }
155 if ( not $subfieldName or $subfieldName eq '' ) {
156 # FIXME I'm not sure the actual implementation is correct.
157 die "This action is not implemented yet";
158 #_update_field({ record => $record, field => $fieldName, values => \@values });
160 _update_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, values => \@values });
166 my $record = $params->{record};
167 my $fieldName = $params->{field};
168 my @values = @{ $params->{values} };
171 if ( my @fields = $record->field( $fieldName ) ) {
172 @values = ($values[0]) x scalar( @fields )
174 foreach my $field ( @fields ) {
175 $field->update( $values[$i++] );
178 ## Field does not exists, create it
179 if ( $fieldName < 10 ) {
180 foreach my $value ( @values ) {
181 my $field = MARC::Field->new( $fieldName, $value );
182 $record->append_fields( $field );
185 warn "Invalid operation, trying to add a new field without subfield";
190 sub _update_subfield {
192 my $record = $params->{record};
193 my $fieldName = $params->{field};
194 my $subfieldName = $params->{subfield};
195 my @values = @{ $params->{values} };
196 my $dont_erase = $params->{dont_erase};
199 if ( my @fields = $record->field( $fieldName ) ) {
200 unless ( $dont_erase ) {
201 @values = ($values[0]) x scalar( @fields )
203 foreach my $field ( @fields ) {
204 $field->update( "$subfieldName" => $values[$i++] );
207 if ( $i <= scalar ( @values ) - 1 ) {
208 foreach my $field ( @fields ) {
209 foreach my $j ( $i .. scalar( @values ) - 1) {
210 $field->add_subfields( "$subfieldName" => $values[$j] );
215 ## Field does not exist, create it.
216 foreach my $value ( @values ) {
217 my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
218 $record->append_fields( $field );
225 my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
227 Returns an array of field values for the given field and subfield
229 If $n is given, it will return only the $nth value of the array.
230 E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
236 my $record = $params->{record};
237 my $fieldName = $params->{field};
238 my $subfieldName = $params->{subfield};
239 my $n = $params->{n};
241 if ( not $subfieldName or $subfieldName eq '' ) {
242 _read_field({ record => $record, field => $fieldName, n => $n });
244 _read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
250 my $record = $params->{record};
251 my $fieldName = $params->{field};
252 my $n = $params->{n};
254 my @fields = $record->field( $fieldName );
256 return unless @fields;
258 return map { $_->data() } @fields
263 if ( $n <= scalar( @fields ) ) {
264 for my $sf ( $fields[$n - 1]->subfields ) {
265 push @values, $sf->[1];
269 foreach my $field ( @fields ) {
270 for my $sf ( $field->subfields ) {
271 push @values, $sf->[1];
281 my $record = $params->{record};
282 my $fieldName = $params->{field};
283 my $subfieldName = $params->{subfield};
284 my $n = $params->{n};
286 my @fields = $record->field( $fieldName );
288 return unless @fields;
291 foreach my $field ( @fields ) {
292 my @sf = $field->subfield( $subfieldName );
293 push( @values, @sf );
303 $bool = field_exists( $record, $fieldName[, $subfieldName ]);
305 Returns true if the field exits, false otherwise.
311 my $record = $params->{record};
312 my $fieldName = $params->{field};
313 my $subfieldName = $params->{subfield};
315 if ( ! $record ) { return; }
318 if ( $fieldName && $subfieldName ) {
319 $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
320 } elsif ( $fieldName ) {
321 $return = $record->field( $fieldName ) && 1;
329 $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
331 Returns true if the field equals the given value, false otherwise.
333 If a regular expression ( $regex ) is supplied, the value will be compared using
334 the given regex. Example: $regex = 'sought_text'
336 If $n is passed, the Nth field of a repeatable series will be used for comparison.
337 Set $n to 1 or leave empty for a non-repeatable field.
343 my $record = $params->{record};
344 my $value = $params->{value};
345 my $fieldName = $params->{field};
346 my $subfieldName = $params->{subfield};
347 my $regex = $params->{regex};
348 my $n = $params->{n};
349 $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
351 if ( ! $record ) { return; }
353 my @field_values = read_field({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
354 my $field_value = $field_values[$n-1];
357 return $field_value =~ m/$value/;
359 return $field_value eq $value;
365 move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
367 Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
368 the value will be transformed by the given regex before being moved into the new field.
369 Example: $regex = 's/Old Text/Replacement Text/'
371 If $n is passed, only the Nth field will be moved. $n = 1
372 will move the first repeatable field, $n = 3 will move the third.
378 my $record = $params->{record};
379 my $fromFieldName = $params->{from_field};
380 my $fromSubfieldName = $params->{from_subfield};
381 my $toFieldName = $params->{to_field};
382 my $toSubfieldName = $params->{to_subfield};
383 my $regex = $params->{regex};
384 my $n = $params->{n};
386 if ( not $fromSubfieldName or $fromSubfieldName eq ''
387 or not $toSubfieldName or $toSubfieldName eq ''
391 from_field => $fromFieldName,
392 to_field => $toFieldName,
399 from_field => $fromFieldName,
400 from_subfield => $fromSubfieldName,
401 to_field => $toFieldName,
402 to_subfield => $toSubfieldName,
411 my $record = $params->{record};
412 my $fromFieldName = $params->{from_field};
413 my $toFieldName = $params->{to_field};
414 my $regex = $params->{regex};
415 my $n = $params->{n};
418 from_field => $fromFieldName,
419 to_field => $toFieldName,
428 my $record = $params->{record};
429 my $fromFieldName = $params->{from_field};
430 my $fromSubfieldName = $params->{from_subfield};
431 my $toFieldName = $params->{to_field};
432 my $toSubfieldName = $params->{to_subfield};
433 my $regex = $params->{regex};
434 my $n = $params->{n};
437 my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
438 @values = ( $values[$n-1] ) if $n;
439 _modify_values({ values => \@values, regex => $regex });
440 _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => 1, values => \@values });
445 field => $fromFieldName,
446 subfield => $fromSubfieldName,
453 _delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
455 Deletes the given field.
457 If $n is passed, only the Nth field will be deleted. $n = 1
458 will delete the first repeatable field, $n = 3 will delete the third.
464 my $record = $params->{record};
465 my $fieldName = $params->{field};
466 my $subfieldName = $params->{subfield};
467 my $n = $params->{n};
469 if ( not $subfieldName or $subfieldName eq '' ) {
470 _delete_field({ record => $record, field => $fieldName, n => $n });
472 _delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
478 my $record = $params->{record};
479 my $fieldName = $params->{field};
480 my $n = $params->{n};
482 my @fields = $record->field( $fieldName );
484 @fields = ( $fields[$n-1] ) if ( $n );
485 foreach my $field ( @fields ) {
486 $record->delete_field( $field );
490 sub _delete_subfield {
492 my $record = $params->{record};
493 my $fieldName = $params->{field};
494 my $subfieldName = $params->{subfield};
495 my $n = $params->{n};
497 my @fields = $record->field( $fieldName );
499 @fields = ( $fields[$n-1] ) if ( $n );
501 foreach my $field ( @fields ) {
502 $field->delete_subfield( code => $subfieldName );
507 sub _copy_move_field {
509 my $record = $params->{record};
510 my $fromFieldName = $params->{from_field};
511 my $toFieldName = $params->{to_field};
512 my $regex = $params->{regex};
513 my $n = $params->{n};
514 my $action = $params->{action} || 'copy';
516 my @fields = $record->field( $fromFieldName );
517 if ( $n and $n <= scalar( @fields ) ) {
518 @fields = ( $fields[$n - 1] );
521 for my $field ( @fields ) {
522 my $new_field = $field->clone;
523 $new_field->{_tag} = $toFieldName; # Should be replaced by set_tag, introduced by MARC::Field 2.0.4
524 if ( $regex and $regex->{search} ) {
525 for my $subfield ( $new_field->subfields ) {
526 my $value = $subfield->[1];
527 ( $value ) = _modify_values({ values => [ $value ], regex => $regex });
528 $new_field->update( $subfield->[0], $value );
531 $record->append_fields( $new_field );
532 $record->delete_field( $field )
533 if $action eq 'move';
539 my $values = $params->{values};
540 my $regex = $params->{regex};
542 if ( $regex and $regex->{search} ) {
543 $regex->{modifiers} //= q||;
544 my @available_modifiers = qw( i g );
546 for my $modifier ( split //, $regex->{modifiers} ) {
547 $modifiers .= $modifier
548 if grep {/$modifier/} @available_modifiers;
550 foreach my $value ( @$values ) {
551 if ( $modifiers =~ m/^(ig|gi)$/ ) {
552 $value =~ s/$regex->{search}/$regex->{replace}/ig;
554 elsif ( $modifiers eq 'i' ) {
555 $value =~ s/$regex->{search}/$regex->{replace}/i;
557 elsif ( $modifiers eq 'g' ) {
558 $value =~ s/$regex->{search}/$regex->{replace}/g;
561 $value =~ s/$regex->{search}/$regex->{replace}/;