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.
76 my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n, $dont_erase ) = @_;
78 if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
80 my @values = read_field
( $record, $fromFieldName, $fromSubfieldName );
81 @values = ( $values[$n-1] ) if ( $n );
83 if ( $regex and $regex->{search
} ) {
84 $regex->{modifiers
} //= q
||;
85 my @available_modifiers = qw( i g );
87 for my $modifier ( split //, $regex->{modifiers
} ) {
88 $modifiers .= $modifier
89 if grep {/$modifier/} @available_modifiers;
91 foreach my $value ( @values ) {
93 when ( /^(ig|gi)$/ ) {
94 $value =~ s/$regex->{search}/$regex->{replace}/ig;
97 $value =~ s/$regex->{search}/$regex->{replace}/i;
100 $value =~ s/$regex->{search}/$regex->{replace}/g;
103 $value =~ s/$regex->{search}/$regex->{replace}/;
108 update_field
( $record, $toFieldName, $toSubfieldName, $dont_erase, @values );
113 update_field( $record, $fieldName, $subfieldName, $dont_erase, $value[, $value,[ $value ... ] ] );
115 Updates a field with the given value, creating it if neccessary.
117 If multiple values are supplied, they will be used to update a list of repeatable fields
118 until either the fields or the values are all used.
120 If a single value is supplied for a repeated field, that value will be used to update
121 each of the repeated fields.
126 my ( $record, $fieldName, $subfieldName, $dont_erase, @values ) = @_;
128 if ( ! ( $record && $fieldName ) ) { return; }
132 if ( $subfieldName ) {
133 if ( my @fields = $record->field( $fieldName ) ) {
134 unless ( $dont_erase ) {
135 @values = ($values[0]) x
scalar( @fields )
137 foreach my $field ( @fields ) {
138 $field->update( "$subfieldName" => $values[$i++] );
141 if ( $i <= scalar ( @values ) - 1 ) {
142 foreach my $field ( @fields ) {
143 foreach my $j ( $i .. scalar( @values ) - 1) {
144 $field->add_subfields( "$subfieldName" => $values[$j] );
149 ## Field does not exist, create it.
150 foreach my $value ( @values ) {
151 $field = MARC
::Field
->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
152 $record->append_fields( $field );
155 } else { ## No subfield
156 if ( my @fields = $record->field( $fieldName ) ) {
157 @values = ($values[0]) x
scalar( @fields )
159 foreach my $field ( @fields ) {
160 $field->update( $values[$i++] );
163 ## Field does not exists, create it
164 foreach my $value ( @values ) {
165 $field = MARC
::Field
->new( $fieldName, $value );
166 $record->append_fields( $field );
174 my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
176 Returns an array of field values for the given field and subfield
178 If $n is given, it will return only the $nth value of the array.
179 E.g. If $n = 1, it return the 1st value, if $n = 3, it will return the 3rd value.
184 my ( $record, $fieldName, $subfieldName, $n ) = @_;
186 my @fields = $record->field( $fieldName );
188 return map { $_->data() } @fields unless $subfieldName;
191 foreach my $field ( @fields ) {
192 my @sf = $field->subfield( $subfieldName );
193 push( @subfields, @sf );
197 return $subfields[$n-1];
205 $bool = field_exists( $record, $fieldName[, $subfieldName ]);
207 Returns true if the field exits, false otherwise.
212 my ( $record, $fieldName, $subfieldName ) = @_;
214 if ( ! $record ) { return; }
217 if ( $fieldName && $subfieldName ) {
218 $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
219 } elsif ( $fieldName ) {
220 $return = $record->field( $fieldName ) && 1;
228 $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
230 Returns true if the field equals the given value, false otherwise.
232 If a regular expression ( $regex ) is supplied, the value will be compared using
233 the given regex. Example: $regex = 'sought_text'
235 If $n is passed, the Nth field of a repeatable series will be used for comparison.
236 Set $n to 1 or leave empty for a non-repeatable field.
241 my ( $record, $value, $fieldName, $subfieldName, $regex, $n ) = @_;
242 $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
244 if ( ! $record ) { return; }
246 my @field_values = read_field
( $record, $fieldName, $subfieldName, $n );
247 my $field_value = $field_values[$n-1];
250 return $field_value =~ m/$value/;
252 return $field_value eq $value;
258 move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
260 Moves a value from one field to another. If a regular expression ( $regex ) is supplied,
261 the value will be transformed by the given regex before being moved into the new field.
262 Example: $regex = 's/Old Text/Replacement Text/'
264 If $n is passed, only the Nth field will be moved. $n = 1
265 will move the first repeatable field, $n = 3 will move the third.
270 my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
271 copy_field
( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , 'dont_erase' );
272 delete_field
( $record, $fromFieldName, $fromSubfieldName, $n );
277 delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
279 Deletes the given field.
281 If $n is passed, only the Nth field will be deleted. $n = 1
282 will delete the first repeatable field, $n = 3 will delete the third.
287 my ( $record, $fieldName, $subfieldName, $n ) = @_;
289 my @fields = $record->field( $fieldName );
291 @fields = ( $fields[$n-1] ) if ( $n );
293 if ( @fields && !$subfieldName ) {
294 foreach my $field ( @fields ) {
295 $record->delete_field( $field );
297 } elsif ( @fields && $subfieldName ) {
298 foreach my $field ( @fields ) {
299 $field->delete_subfield( code
=> $subfieldName );