1 package Koha::SimpleMARC;
3 # Copyright 2009 Kyle M. Hall <kyle.m.hall@gmail.com>
12 our @ISA = qw(Exporter);
13 our %EXPORT_TAGS = ( 'all' => [ qw(
17 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
29 our $VERSION = '0.01';
35 SimpleMARC - Perl modle for making simple MARC record alterations.
43 SimpleMARC is designed to make writing scripts
44 to modify MARC records simple and easy.
46 Every function in the modules requires a
47 MARC::Record object as its first parameter.
51 Kyle Hall <lt>kyle.m.hall@gmail.com<gt>
53 =head1 COPYRIGHT AND LICENSE
55 Copyright (C) 2009 by Kyle Hall
57 This library is free software; you can redistribute it and/or modify
58 it under the same terms as Perl itself, either Perl version 5.8.7 or,
59 at your option, any later version of Perl 5 you may have available.
65 copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex[, $n ] ] );
67 Copies a value from one field to another. If a regular expression ( $regex ) is supplied,
68 the value will be transformed by the given regex before being copied into the new field.
69 Example: $regex = 's/Old Text/Replacement Text/'
71 If $n is passed, copy_field will only copy the Nth field of the list of fields.
72 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, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n, $dont_erase ) = @_;
78 C4::Koha::Log( "C4::SimpleMARC::copy_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
80 if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
82 my @values = read_field( $record, $fromFieldName, $fromSubfieldName );
83 @values = ( $values[$n-1] ) if ( $n );
84 C4::Koha::Log( "@values = read_field( $record, $fromFieldName, $fromSubfieldName )" ) if $debug >= 3;
87 foreach my $value ( @values ) {
88 C4::Koha::Log( "\$value =~ s$regex" ) if ( $debug >= 3 );
89 eval "\$value =~ s$regex";
93 update_field( $record, $toFieldName, $toSubfieldName, @values, $dont_erase );
99 update_field( $record, $fieldName, $subfieldName, $value[, $value,[ $value ... ] ] );
101 Updates a field with the given value, creating it if neccessary.
103 If multiple values are supplied, they will be used to update a list of repeatable fields
104 until either the fields or the values are all used.
106 If a single value is supplied for a repeated field, that value will be used to update
107 each of the repeated fields.
112 my ( $record, $fieldName, $subfieldName, @values, $dont_erase ) = @_;
113 C4::Koha::Log( "C4::SimpleMARC::update_field( $record, $fieldName, $subfieldName, @values )" ) if $debug;
115 if ( ! ( $record && $fieldName ) ) { return; }
117 if ( @values eq 1 ) {
118 _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, @values );
124 if ( $subfieldName ) {
125 if ( my @fields = $record->field( $fieldName ) ) {
126 unless ( $dont_erase ) {
127 foreach my $field ( @fields ) {
128 $field->update( "$subfieldName" => $values[$i++] );
131 if ( $i <= scalar @values - 1 ) {
132 foreach my $field ( @fields ) {
133 foreach my $j ( $i .. scalar( @values ) - 1) {
134 $field->add_subfields( "$subfieldName" => $values[$j] );
139 ## Field does not exist, create it.
140 foreach my $value ( @values ) {
141 $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
142 $record->append_fields( $field );
145 } else { ## No subfield
146 if ( my @fields = $record->field( $fieldName ) ) {
147 foreach my $field ( @fields ) {
148 $field->update( $values[$i++] );
151 ## Field does not exists, create it
152 foreach my $value ( @values ) {
153 $field = MARC::Field->new( $fieldName, $value );
154 $record->append_fields( $field );
162 my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
164 Returns an array of field values for the given field and subfield
166 If $n is given, it will return only the $nth value of the array.
167 E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
172 my ( $record, $fieldName, $subfieldName, $n ) = @_;
173 C4::Koha::Log( "C4::SimpleMARC::read_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
175 my @fields = $record->field( $fieldName );
177 return @fields unless $subfieldName;
180 foreach my $field ( @fields ) {
181 my @sf = $field->subfield( $subfieldName );
182 push( @subfields, @sf );
186 return $subfields[$n-1];
194 $bool = field_exists( $record, $fieldName[, $subfieldName ]);
196 Returns true if the field exits, false otherwise.
201 my ( $record, $fieldName, $subfieldName ) = @_;
202 C4::Koha::Log( "C4::SimpleMARC::field_exists( $record, $fieldName, $subfieldName )" ) if $debug;
204 if ( ! $record ) { return; }
207 if ( $fieldName && $subfieldName ) {
208 $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
209 } elsif ( $fieldName ) {
210 $return = $record->field( $fieldName ) && 1;
213 C4::Koha::Log( "C4:SimpleMARC::field_exists: Returning '$return'" ) if $debug >= 2;
219 $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
221 Returns true if the field equals the given value, false otherwise.
223 If a regular expression ( $regex ) is supplied, the value will be compared using
224 the given regex. Example: $regex = 'm/sought_text/'
226 If $n is passed, the Nth field of a repeatable series will be used for comparison.
227 Set $n to 1 or leave empty for a non-repeatable field.
232 my ( $record, $value, $fieldName, $subfieldName, $regex, $n ) = @_;
233 $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
234 C4::Koha::Log( "C4::SimpleMARC::field_equals( '$record', '$value', '$fieldName', '$subfieldName', '$regex', '$n')" ) if $debug;
236 if ( ! $record ) { return; }
238 my @field_values = read_field( $record, $fieldName, $subfieldName, $n );
239 my $field_value = $field_values[$n-1];
242 C4::Koha::Log( "Testing '$field_value' =~ m$value" ) if $debug >= 3;
243 return eval "\$field_value =~ m$value";
245 return $field_value eq $value;
251 move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
253 Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
254 the value will be transformed by the given regex before being moved into the new field.
255 Example: $regex = 's/Old Text/Replacement Text/'
257 If $n is passed, only the Nth field will be moved. $n = 1
258 will move the first repeatable field, $n = 3 will move the third.
263 my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
264 C4::Koha::Log( "C4::SimpleMARC::move_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
265 copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , "don't_erase");
266 delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
271 delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
273 Deletes the given field.
275 If $n is passed, only the Nth field will be deleted. $n = 1
276 will delete the first repeatable field, $n = 3 will delete the third.
281 my ( $record, $fieldName, $subfieldName, $n ) = @_;
282 C4::Koha::Log( "C4::SimpleMARC::delete_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
284 my @fields = $record->field( $fieldName );
286 @fields = ( $fields[$n-1] ) if ( $n );
288 if ( @fields && !$subfieldName ) {
289 foreach my $field ( @fields ) {
290 $record->delete_field( $field );
292 } elsif ( @fields && $subfieldName ) {
293 foreach my $field ( @fields ) {
294 $field->delete_subfield( code => $subfieldName );
301 _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value );
303 Updates a repeatable field, giving all existing copies of that field the given value.
305 This is an internal function, and thus is not exported.
309 sub _update_repeatable_field_with_single_value {
310 my ( $record, $fieldName, $subfieldName, $value ) = @_;
311 C4::Koha::Log( "C4::SimpleMARC::_update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value )" ) if $debug;
313 if ( ! ( $record && $fieldName ) ) { return; }
316 if ( $subfieldName ) {
317 if ( my @fields = $record->field( $fieldName ) ) {
318 foreach my $field ( @fields ) {
319 $field->update( "$subfieldName" => $value );
322 ## Field does not exist, create it.
323 $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $value );
324 $record->append_fields( $field );
326 } else { ## No subfield
327 if ( my @fields = $record->field( $fieldName ) ) {
328 foreach my $field ( @fields ) {
329 $field->update( $value );
332 ## Field does not exists, create it
333 $field = MARC::Field->new( $fieldName, $value );
334 $record->append_fields( $field );