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};
84 my $dont_erase = $params->{dont_erase};
86 if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
88 my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
89 @values = ( $values[$n-1] ) if ( $n );
91 if ( $regex and $regex->{search} ) {
92 $regex->{modifiers} //= q||;
93 my @available_modifiers = qw( i g );
95 for my $modifier ( split //, $regex->{modifiers} ) {
96 $modifiers .= $modifier
97 if grep {/$modifier/} @available_modifiers;
99 foreach my $value (@values) {
100 if ( $modifiers =~ m/^(ig|gi)$/ ) {
101 $value =~ s/$regex->{search}/$regex->{replace}/ig;
103 elsif ( $modifiers eq 'i' ) {
104 $value =~ s/$regex->{search}/$regex->{replace}/i;
106 elsif ( $modifiers eq 'g' ) {
107 $value =~ s/$regex->{search}/$regex->{replace}/g;
110 $value =~ s/$regex->{search}/$regex->{replace}/;
114 update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => $dont_erase, values => \@values });
119 update_field( $record, $fieldName, $subfieldName, $dont_erase, $value[, $value,[ $value ... ] ] );
121 Updates a field with the given value, creating it if neccessary.
123 If multiple values are supplied, they will be used to update a list of repeatable fields
124 until either the fields or the values are all used.
126 If a single value is supplied for a repeated field, that value will be used to update
127 each of the repeated fields.
133 my $record = $params->{record};
134 my $fieldName = $params->{field};
135 my $subfieldName = $params->{subfield};
136 my $dont_erase = $params->{dont_erase};
137 my @values = @{ $params->{values} };
139 if ( ! ( $record && $fieldName ) ) { return; }
143 if ( $subfieldName ) {
144 if ( my @fields = $record->field( $fieldName ) ) {
145 unless ( $dont_erase ) {
146 @values = ($values[0]) x scalar( @fields )
148 foreach my $field ( @fields ) {
149 $field->update( "$subfieldName" => $values[$i++] );
152 if ( $i <= scalar ( @values ) - 1 ) {
153 foreach my $field ( @fields ) {
154 foreach my $j ( $i .. scalar( @values ) - 1) {
155 $field->add_subfields( "$subfieldName" => $values[$j] );
160 ## Field does not exist, create it.
161 foreach my $value ( @values ) {
162 $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
163 $record->append_fields( $field );
166 } else { ## No subfield
167 if ( my @fields = $record->field( $fieldName ) ) {
168 @values = ($values[0]) x scalar( @fields )
170 foreach my $field ( @fields ) {
171 $field->update( $values[$i++] );
174 ## Field does not exists, create it
175 foreach my $value ( @values ) {
176 $field = MARC::Field->new( $fieldName, $value );
177 $record->append_fields( $field );
185 my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
187 Returns an array of field values for the given field and subfield
189 If $n is given, it will return only the $nth value of the array.
190 E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
196 my $record = $params->{record};
197 my $fieldName = $params->{field};
198 my $subfieldName = $params->{subfield};
199 my $n = $params->{n};
201 my @fields = $record->field( $fieldName );
203 return map { $_->data() } @fields unless $subfieldName;
206 foreach my $field ( @fields ) {
207 my @sf = $field->subfield( $subfieldName );
208 push( @subfields, @sf );
212 return $subfields[$n-1];
220 $bool = field_exists( $record, $fieldName[, $subfieldName ]);
222 Returns true if the field exits, false otherwise.
228 my $record = $params->{record};
229 my $fieldName = $params->{field};
230 my $subfieldName = $params->{subfield};
232 if ( ! $record ) { return; }
235 if ( $fieldName && $subfieldName ) {
236 $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
237 } elsif ( $fieldName ) {
238 $return = $record->field( $fieldName ) && 1;
246 $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
248 Returns true if the field equals the given value, false otherwise.
250 If a regular expression ( $regex ) is supplied, the value will be compared using
251 the given regex. Example: $regex = 'sought_text'
253 If $n is passed, the Nth field of a repeatable series will be used for comparison.
254 Set $n to 1 or leave empty for a non-repeatable field.
260 my $record = $params->{record};
261 my $value = $params->{value};
262 my $fieldName = $params->{field};
263 my $subfieldName = $params->{subfield};
264 my $regex = $params->{regex};
265 my $n = $params->{n};
266 $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
268 if ( ! $record ) { return; }
270 my @field_values = read_field({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
271 my $field_value = $field_values[$n-1];
274 return $field_value =~ m/$value/;
276 return $field_value eq $value;
282 move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
284 Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
285 the value will be transformed by the given regex before being moved into the new field.
286 Example: $regex = 's/Old Text/Replacement Text/'
288 If $n is passed, only the Nth field will be moved. $n = 1
289 will move the first repeatable field, $n = 3 will move the third.
295 my $record = $params->{record};
296 my $fromFieldName = $params->{from_field};
297 my $fromSubfieldName = $params->{from_subfield};
298 my $toFieldName = $params->{to_field};
299 my $toSubfieldName = $params->{to_subfield};
300 my $regex = $params->{regex};
301 my $n = $params->{n};
303 copy_field({ record => $record, from_field => $fromFieldName, from_subfield => $fromSubfieldName, to_field => $toFieldName, to_subfield => $toSubfieldName, regex => $regex, n => $n , dont_erase => 1 });
304 delete_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName, n => $n });
309 delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
311 Deletes the given field.
313 If $n is passed, only the Nth field will be deleted. $n = 1
314 will delete the first repeatable field, $n = 3 will delete the third.
320 my $record = $params->{record};
321 my $fieldName = $params->{field};
322 my $subfieldName = $params->{subfield};
323 my $n = $params->{n};
325 my @fields = $record->field( $fieldName );
327 @fields = ( $fields[$n-1] ) if ( $n );
329 if ( @fields && !$subfieldName ) {
330 foreach my $field ( @fields ) {
331 $record->delete_field( $field );
333 } elsif ( @fields && $subfieldName ) {
334 foreach my $field ( @fields ) {
335 $field->delete_subfield( code => $subfieldName );