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 ) = @_;
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 );
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 ) = @_;
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 foreach my $field ( @fields ) {
127 $field->update( "$subfieldName" => $values[$i++] );
130 ## Field does not exist, create it.
131 foreach my $value ( @values ) {
132 $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
133 $record->append_fields( $field );
136 } else { ## No subfield
137 if ( my @fields = $record->field( $fieldName ) ) {
138 foreach my $field ( @fields ) {
139 $field->update( $values[$i++] );
142 ## Field does not exists, create it
143 foreach my $value ( @values ) {
144 $field = MARC::Field->new( $fieldName, $value );
145 $record->append_fields( $field );
153 my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
155 Returns an array of field values for the given field and subfield
157 If $n is given, it will return only the $nth value of the array.
158 E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
163 my ( $record, $fieldName, $subfieldName, $n ) = @_;
164 C4::Koha::Log( "C4::SimpleMARC::read_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
166 my @fields = $record->field( $fieldName );
168 return @fields unless $subfieldName;
171 foreach my $field ( @fields ) {
172 my @sf = $field->subfield( $subfieldName );
173 push( @subfields, @sf );
177 return $subfields[$n-1];
185 $bool = field_exists( $record, $fieldName[, $subfieldName ]);
187 Returns true if the field exits, false otherwise.
192 my ( $record, $fieldName, $subfieldName ) = @_;
193 C4::Koha::Log( "C4::SimpleMARC::field_exists( $record, $fieldName, $subfieldName )" ) if $debug;
195 if ( ! $record ) { return; }
198 if ( $fieldName && $subfieldName ) {
199 $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
200 } elsif ( $fieldName ) {
201 $return = $record->field( $fieldName ) && 1;
204 C4::Koha::Log( "C4:SimpleMARC::field_exists: Returning '$return'" ) if $debug >= 2;
210 $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
212 Returns true if the field equals the given value, false otherwise.
214 If a regular expression ( $regex ) is supplied, the value will be compared using
215 the given regex. Example: $regex = 'm/sought_text/'
217 If $n is passed, the Nth field of a repeatable series will be used for comparison.
218 Set $n to 1 or leave empty for a non-repeatable field.
223 my ( $record, $value, $fieldName, $subfieldName, $regex, $n ) = @_;
224 $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
225 C4::Koha::Log( "C4::SimpleMARC::field_equals( '$record', '$value', '$fieldName', '$subfieldName', '$regex', '$n')" ) if $debug;
227 if ( ! $record ) { return; }
229 my @field_values = read_field( $record, $fieldName, $subfieldName, $n );
230 my $field_value = $field_values[$n-1];
233 C4::Koha::Log( "Testing '$field_value' =~ m$value" ) if $debug >= 3;
234 return eval "\$field_value =~ m$value";
236 return $field_value eq $value;
242 move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
244 Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
245 the value will be transformed by the given regex before being moved into the new field.
246 Example: $regex = 's/Old Text/Replacement Text/'
248 If $n is passed, only the Nth field will be moved. $n = 1
249 will move the first repeatable field, $n = 3 will move the third.
254 my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
255 C4::Koha::Log( "C4::SimpleMARC::move_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
256 copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n );
257 delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
262 delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
264 Deletes the given field.
266 If $n is passed, only the Nth field will be deleted. $n = 1
267 will delete the first repeatable field, $n = 3 will delete the third.
272 my ( $record, $fieldName, $subfieldName, $n ) = @_;
273 C4::Koha::Log( "C4::SimpleMARC::delete_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
275 my @fields = $record->field( $fieldName );
277 @fields = ( $fields[$n-1] ) if ( $n );
279 if ( @fields && !$subfieldName ) {
280 foreach my $field ( @fields ) {
281 $record->delete_field( $field );
283 } elsif ( @fields && $subfieldName ) {
284 foreach my $field ( @fields ) {
285 $field->delete_subfield( code => $subfieldName );
292 _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value );
294 Updates a repeatable field, giving all existing copies of that field the given value.
296 This is an internal function, and thus is not exported.
300 sub _update_repeatable_field_with_single_value {
301 my ( $record, $fieldName, $subfieldName, $value ) = @_;
302 C4::Koha::Log( "C4::SimpleMARC::_update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value )" ) if $debug;
304 if ( ! ( $record && $fieldName ) ) { return; }
307 if ( $subfieldName ) {
308 if ( my @fields = $record->field( $fieldName ) ) {
309 foreach my $field ( @fields ) {
310 $field->update( "$subfieldName" => $value );
313 ## Field does not exist, create it.
314 $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $value );
315 $record->append_fields( $field );
317 } else { ## No subfield
318 if ( my @fields = $record->field( $fieldName ) ) {
319 foreach my $field ( @fields ) {
320 $field->update( $value );
323 ## Field does not exists, create it
324 $field = MARC::Field->new( $fieldName, $value );
325 $record->append_fields( $field );