Lines 73-183
at your option, any later version of Perl 5 you may have available.
Link Here
|
73 |
=cut |
73 |
=cut |
74 |
|
74 |
|
75 |
sub copy_field { |
75 |
sub copy_field { |
76 |
my ( $params ) = @_; |
76 |
my ( $params ) = @_; |
77 |
my $record = $params->{record}; |
77 |
my $record = $params->{record}; |
78 |
my $fromFieldName = $params->{from_field}; |
78 |
my $fromFieldName = $params->{from_field}; |
79 |
my $fromSubfieldName = $params->{from_subfield}; |
79 |
my $fromSubfieldName = $params->{from_subfield}; |
80 |
my $toFieldName = $params->{to_field}; |
80 |
my $toFieldName = $params->{to_field}; |
81 |
my $toSubfieldName = $params->{to_subfield}; |
81 |
my $toSubfieldName = $params->{to_subfield}; |
82 |
my $regex = $params->{regex}; |
82 |
my $regex = $params->{regex}; |
83 |
my $n = $params->{n}; |
83 |
my $n = $params->{n}; |
84 |
my $dont_erase = $params->{dont_erase}; |
84 |
|
85 |
|
85 |
if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; } |
86 |
if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; } |
86 |
|
87 |
|
87 |
|
88 |
my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName }); |
88 |
if ( not $fromSubfieldName or $fromSubfieldName eq '' |
89 |
@values = ( $values[$n-1] ) if ( $n ); |
89 |
or not $toSubfieldName or $toSubfieldName eq '' |
90 |
|
90 |
) { |
91 |
if ( $regex and $regex->{search} ) { |
91 |
_copy_field({ |
92 |
$regex->{modifiers} //= q||; |
92 |
record => $record, |
93 |
my @available_modifiers = qw( i g ); |
93 |
from_field => $fromFieldName, |
94 |
my $modifiers = q||; |
94 |
to_field => $toFieldName, |
95 |
for my $modifier ( split //, $regex->{modifiers} ) { |
95 |
regex => $regex, |
96 |
$modifiers .= $modifier |
96 |
n => $n |
97 |
if grep {/$modifier/} @available_modifiers; |
97 |
}); |
98 |
} |
98 |
} else { |
99 |
foreach my $value (@values) { |
99 |
_copy_subfield({ |
100 |
if ( $modifiers =~ m/^(ig|gi)$/ ) { |
100 |
record => $record, |
101 |
$value =~ s/$regex->{search}/$regex->{replace}/ig; |
101 |
from_field => $fromFieldName, |
102 |
} |
102 |
from_subfield => $fromSubfieldName, |
103 |
elsif ( $modifiers eq 'i' ) { |
103 |
to_field => $toFieldName, |
104 |
$value =~ s/$regex->{search}/$regex->{replace}/i; |
104 |
to_subfield => $toSubfieldName, |
105 |
} |
105 |
regex => $regex, |
106 |
elsif ( $modifiers eq 'g' ) { |
106 |
n => $n |
107 |
$value =~ s/$regex->{search}/$regex->{replace}/g; |
107 |
}); |
108 |
} |
|
|
109 |
else { |
110 |
$value =~ s/$regex->{search}/$regex->{replace}/; |
111 |
} |
112 |
} |
108 |
} |
113 |
} |
|
|
114 |
update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => $dont_erase, values => \@values }); |
115 |
} |
116 |
|
117 |
=head2 update_field |
118 |
|
109 |
|
119 |
update_field( $record, $fieldName, $subfieldName, $dont_erase, $value[, $value,[ $value ... ] ] ); |
110 |
} |
120 |
|
|
|
121 |
Updates a field with the given value, creating it if neccessary. |
122 |
|
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. |
125 |
|
111 |
|
126 |
If a single value is supplied for a repeated field, that value will be used to update |
112 |
sub _copy_field { |
127 |
each of the repeated fields. |
113 |
my ( $params ) = @_; |
|
|
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}; |
119 |
|
120 |
_copy_move_field({ |
121 |
record => $record, |
122 |
from_field => $fromFieldName, |
123 |
to_field => $toFieldName, |
124 |
regex => $regex, |
125 |
n => $n |
126 |
}); |
127 |
} |
128 |
|
128 |
|
129 |
=cut |
129 |
sub _copy_subfield { |
|
|
130 |
my ( $params ) = @_; |
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}; |
138 |
|
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 }); |
142 |
|
143 |
update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values }); |
144 |
} |
130 |
|
145 |
|
131 |
sub update_field { |
146 |
sub update_field { |
132 |
my ( $params ) = @_; |
147 |
my ( $params ) = @_; |
133 |
my $record = $params->{record}; |
148 |
my $record = $params->{record}; |
134 |
my $fieldName = $params->{field}; |
149 |
my $fieldName = $params->{field}; |
135 |
my $subfieldName = $params->{subfield}; |
150 |
my $subfieldName = $params->{subfield}; |
136 |
my $dont_erase = $params->{dont_erase}; |
151 |
my @values = @{ $params->{values} }; |
137 |
my @values = @{ $params->{values} }; |
152 |
|
|
|
153 |
if ( ! ( $record && $fieldName ) ) { return; } |
154 |
|
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 }); |
159 |
} else { |
160 |
_update_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, values => \@values }); |
161 |
} |
162 |
} |
138 |
|
163 |
|
139 |
if ( ! ( $record && $fieldName ) ) { return; } |
164 |
sub _update_field { |
|
|
165 |
my ( $params ) = @_; |
166 |
my $record = $params->{record}; |
167 |
my $fieldName = $params->{field}; |
168 |
my @values = @{ $params->{values} }; |
140 |
|
169 |
|
141 |
my $i = 0; |
170 |
my $i = 0; |
142 |
my $field; |
|
|
143 |
if ( $subfieldName ) { |
144 |
if ( my @fields = $record->field( $fieldName ) ) { |
171 |
if ( my @fields = $record->field( $fieldName ) ) { |
145 |
unless ( $dont_erase ) { |
|
|
146 |
@values = ($values[0]) x scalar( @fields ) |
172 |
@values = ($values[0]) x scalar( @fields ) |
147 |
if @values == 1; |
173 |
if @values == 1; |
148 |
foreach my $field ( @fields ) { |
174 |
foreach my $field ( @fields ) { |
149 |
$field->update( "$subfieldName" => $values[$i++] ); |
175 |
$field->update( $values[$i++] ); |
150 |
} |
176 |
} |
151 |
} |
|
|
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] ); |
156 |
} |
157 |
} |
158 |
} |
159 |
} else { |
177 |
} else { |
160 |
## Field does not exist, create it. |
178 |
## Field does not exists, create it |
161 |
foreach my $value ( @values ) { |
179 |
if ( $fieldName < 10 ) { |
162 |
$field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] ); |
180 |
foreach my $value ( @values ) { |
163 |
$record->append_fields( $field ); |
181 |
my $field = MARC::Field->new( $fieldName, $value ); |
164 |
} |
182 |
$record->append_fields( $field ); |
|
|
183 |
} |
184 |
} else { |
185 |
warn "Invalid operation, trying to add a new field without subfield"; |
186 |
} |
165 |
} |
187 |
} |
166 |
} else { ## No subfield |
188 |
} |
|
|
189 |
|
190 |
sub _update_subfield { |
191 |
my ( $params ) = @_; |
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}; |
197 |
my $i = 0; |
198 |
|
167 |
if ( my @fields = $record->field( $fieldName ) ) { |
199 |
if ( my @fields = $record->field( $fieldName ) ) { |
168 |
@values = ($values[0]) x scalar( @fields ) |
200 |
unless ( $dont_erase ) { |
169 |
if @values == 1; |
201 |
@values = ($values[0]) x scalar( @fields ) |
170 |
foreach my $field ( @fields ) { |
202 |
if @values == 1; |
171 |
$field->update( $values[$i++] ); |
203 |
foreach my $field ( @fields ) { |
172 |
} |
204 |
$field->update( "$subfieldName" => $values[$i++] ); |
|
|
205 |
} |
206 |
} |
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] ); |
211 |
} |
212 |
} |
213 |
} |
173 |
} else { |
214 |
} else { |
174 |
## Field does not exists, create it |
215 |
## Field does not exist, create it. |
175 |
foreach my $value ( @values ) { |
216 |
foreach my $value ( @values ) { |
176 |
$field = MARC::Field->new( $fieldName, $value ); |
217 |
my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] ); |
177 |
$record->append_fields( $field ); |
218 |
$record->append_fields( $field ); |
178 |
} |
219 |
} |
179 |
} |
220 |
} |
180 |
} |
|
|
181 |
} |
221 |
} |
182 |
|
222 |
|
183 |
=head2 read_field |
223 |
=head2 read_field |
Lines 192-218
sub update_field {
Link Here
|
192 |
=cut |
232 |
=cut |
193 |
|
233 |
|
194 |
sub read_field { |
234 |
sub read_field { |
195 |
my ( $params ) = @_; |
235 |
my ( $params ) = @_; |
196 |
my $record = $params->{record}; |
236 |
my $record = $params->{record}; |
197 |
my $fieldName = $params->{field}; |
237 |
my $fieldName = $params->{field}; |
198 |
my $subfieldName = $params->{subfield}; |
238 |
my $subfieldName = $params->{subfield}; |
199 |
my $n = $params->{n}; |
239 |
my $n = $params->{n}; |
|
|
240 |
|
241 |
if ( not $subfieldName or $subfieldName eq '' ) { |
242 |
_read_field({ record => $record, field => $fieldName, n => $n }); |
243 |
} else { |
244 |
_read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n }); |
245 |
} |
246 |
} |
200 |
|
247 |
|
201 |
my @fields = $record->field( $fieldName ); |
248 |
sub _read_field { |
|
|
249 |
my ( $params ) = @_; |
250 |
my $record = $params->{record}; |
251 |
my $fieldName = $params->{field}; |
252 |
my $n = $params->{n}; |
202 |
|
253 |
|
203 |
return map { $_->data() } @fields unless $subfieldName; |
254 |
my @fields = $record->field( $fieldName ); |
204 |
|
255 |
|
205 |
my @subfields; |
256 |
return unless @fields; |
206 |
foreach my $field ( @fields ) { |
|
|
207 |
my @sf = $field->subfield( $subfieldName ); |
208 |
push( @subfields, @sf ); |
209 |
} |
210 |
|
257 |
|
211 |
if ( $n ) { |
258 |
return map { $_->data() } @fields |
212 |
return $subfields[$n-1]; |
259 |
if $fieldName < 10; |
213 |
} else { |
260 |
|
214 |
return @subfields; |
261 |
my @values; |
215 |
} |
262 |
if ( $n ) { |
|
|
263 |
if ( $n <= scalar( @fields ) ) { |
264 |
for my $sf ( $fields[$n - 1]->subfields ) { |
265 |
push @values, $sf->[1]; |
266 |
} |
267 |
} |
268 |
} else { |
269 |
foreach my $field ( @fields ) { |
270 |
for my $sf ( $field->subfields ) { |
271 |
push @values, $sf->[1]; |
272 |
} |
273 |
} |
274 |
} |
275 |
|
276 |
return @values; |
277 |
} |
278 |
|
279 |
sub _read_subfield { |
280 |
my ( $params ) = @_; |
281 |
my $record = $params->{record}; |
282 |
my $fieldName = $params->{field}; |
283 |
my $subfieldName = $params->{subfield}; |
284 |
my $n = $params->{n}; |
285 |
|
286 |
my @fields = $record->field( $fieldName ); |
287 |
|
288 |
return unless @fields; |
289 |
|
290 |
my @values; |
291 |
foreach my $field ( @fields ) { |
292 |
my @sf = $field->subfield( $subfieldName ); |
293 |
push( @values, @sf ); |
294 |
} |
295 |
|
296 |
return $n |
297 |
? $values[$n-1] |
298 |
: @values; |
216 |
} |
299 |
} |
217 |
|
300 |
|
218 |
=head2 field_exists |
301 |
=head2 field_exists |
Lines 291-312
sub field_equals {
Link Here
|
291 |
=cut |
374 |
=cut |
292 |
|
375 |
|
293 |
sub move_field { |
376 |
sub move_field { |
294 |
my ( $params ) = @_; |
377 |
my ( $params ) = @_; |
295 |
my $record = $params->{record}; |
378 |
my $record = $params->{record}; |
296 |
my $fromFieldName = $params->{from_field}; |
379 |
my $fromFieldName = $params->{from_field}; |
297 |
my $fromSubfieldName = $params->{from_subfield}; |
380 |
my $fromSubfieldName = $params->{from_subfield}; |
298 |
my $toFieldName = $params->{to_field}; |
381 |
my $toFieldName = $params->{to_field}; |
299 |
my $toSubfieldName = $params->{to_subfield}; |
382 |
my $toSubfieldName = $params->{to_subfield}; |
300 |
my $regex = $params->{regex}; |
383 |
my $regex = $params->{regex}; |
301 |
my $n = $params->{n}; |
384 |
my $n = $params->{n}; |
|
|
385 |
|
386 |
if ( not $fromSubfieldName or $fromSubfieldName eq '' |
387 |
or not $toSubfieldName or $toSubfieldName eq '' |
388 |
) { |
389 |
_move_field({ |
390 |
record => $record, |
391 |
from_field => $fromFieldName, |
392 |
to_field => $toFieldName, |
393 |
regex => $regex, |
394 |
n => $n, |
395 |
}); |
396 |
} else { |
397 |
_move_subfield({ |
398 |
record => $record, |
399 |
from_field => $fromFieldName, |
400 |
from_subfield => $fromSubfieldName, |
401 |
to_field => $toFieldName, |
402 |
to_subfield => $toSubfieldName, |
403 |
regex => $regex, |
404 |
n => $n, |
405 |
}); |
406 |
} |
407 |
} |
302 |
|
408 |
|
303 |
copy_field({ record => $record, from_field => $fromFieldName, from_subfield => $fromSubfieldName, to_field => $toFieldName, to_subfield => $toSubfieldName, regex => $regex, n => $n , dont_erase => 1 }); |
409 |
sub _move_field { |
304 |
delete_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName, n => $n }); |
410 |
my ( $params ) = @_; |
|
|
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}; |
416 |
_copy_move_field({ |
417 |
record => $record, |
418 |
from_field => $fromFieldName, |
419 |
to_field => $toFieldName, |
420 |
regex => $regex, |
421 |
n => $n, |
422 |
action => 'move', |
423 |
}); |
305 |
} |
424 |
} |
306 |
|
425 |
|
307 |
=head2 delete_field |
426 |
sub _move_subfield { |
|
|
427 |
my ( $params ) = @_; |
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}; |
435 |
|
436 |
# Copy |
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 }); |
441 |
|
442 |
# And delete |
443 |
_delete_subfield({ |
444 |
record => $record, |
445 |
field => $fromFieldName, |
446 |
subfield => $fromSubfieldName, |
447 |
n => $n, |
448 |
}); |
449 |
} |
450 |
|
451 |
=head2 _delete_field |
308 |
|
452 |
|
309 |
delete_field( $record, $fieldName[, $subfieldName [, $n ] ] ); |
453 |
_delete_field( $record, $fieldName[, $subfieldName [, $n ] ] ); |
310 |
|
454 |
|
311 |
Deletes the given field. |
455 |
Deletes the given field. |
312 |
|
456 |
|
Lines 316-341
sub move_field {
Link Here
|
316 |
=cut |
460 |
=cut |
317 |
|
461 |
|
318 |
sub delete_field { |
462 |
sub delete_field { |
319 |
my ( $params ) = @_; |
463 |
my ( $params ) = @_; |
320 |
my $record = $params->{record}; |
464 |
my $record = $params->{record}; |
321 |
my $fieldName = $params->{field}; |
465 |
my $fieldName = $params->{field}; |
322 |
my $subfieldName = $params->{subfield}; |
466 |
my $subfieldName = $params->{subfield}; |
323 |
my $n = $params->{n}; |
467 |
my $n = $params->{n}; |
|
|
468 |
|
469 |
if ( not $subfieldName or $subfieldName eq '' ) { |
470 |
_delete_field({ record => $record, field => $fieldName, n => $n }); |
471 |
} else { |
472 |
_delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n }); |
473 |
} |
474 |
} |
324 |
|
475 |
|
325 |
my @fields = $record->field( $fieldName ); |
476 |
sub _delete_field { |
|
|
477 |
my ( $params ) = @_; |
478 |
my $record = $params->{record}; |
479 |
my $fieldName = $params->{field}; |
480 |
my $n = $params->{n}; |
326 |
|
481 |
|
327 |
@fields = ( $fields[$n-1] ) if ( $n ); |
482 |
my @fields = $record->field( $fieldName ); |
328 |
|
483 |
|
329 |
if ( @fields && !$subfieldName ) { |
484 |
@fields = ( $fields[$n-1] ) if ( $n ); |
330 |
foreach my $field ( @fields ) { |
485 |
foreach my $field ( @fields ) { |
331 |
$record->delete_field( $field ); |
486 |
$record->delete_field( $field ); |
332 |
} |
487 |
} |
333 |
} elsif ( @fields && $subfieldName ) { |
488 |
} |
|
|
489 |
|
490 |
sub _delete_subfield { |
491 |
my ( $params ) = @_; |
492 |
my $record = $params->{record}; |
493 |
my $fieldName = $params->{field}; |
494 |
my $subfieldName = $params->{subfield}; |
495 |
my $n = $params->{n}; |
496 |
|
497 |
my @fields = $record->field( $fieldName ); |
498 |
|
499 |
@fields = ( $fields[$n-1] ) if ( $n ); |
500 |
|
334 |
foreach my $field ( @fields ) { |
501 |
foreach my $field ( @fields ) { |
335 |
$field->delete_subfield( code => $subfieldName ); |
502 |
$field->delete_subfield( code => $subfieldName ); |
336 |
} |
503 |
} |
337 |
} |
|
|
338 |
} |
504 |
} |
339 |
|
505 |
|
|
|
506 |
|
507 |
sub _copy_move_field { |
508 |
my ( $params ) = @_; |
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'; |
515 |
|
516 |
my @fields = $record->field( $fromFieldName ); |
517 |
if ( $n and $n <= scalar( @fields ) ) { |
518 |
@fields = ( $fields[$n - 1] ); |
519 |
} |
520 |
|
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 ); |
529 |
} |
530 |
} |
531 |
$record->append_fields( $new_field ); |
532 |
$record->delete_field( $field ) |
533 |
if $action eq 'move'; |
534 |
} |
535 |
} |
536 |
|
537 |
sub _modify_values { |
538 |
my ( $params ) = @_; |
539 |
my $values = $params->{values}; |
540 |
my $regex = $params->{regex}; |
541 |
|
542 |
if ( $regex and $regex->{search} ) { |
543 |
$regex->{modifiers} //= q||; |
544 |
my @available_modifiers = qw( i g ); |
545 |
my $modifiers = q||; |
546 |
for my $modifier ( split //, $regex->{modifiers} ) { |
547 |
$modifiers .= $modifier |
548 |
if grep {/$modifier/} @available_modifiers; |
549 |
} |
550 |
foreach my $value ( @$values ) { |
551 |
if ( $modifiers =~ m/^(ig|gi)$/ ) { |
552 |
$value =~ s/$regex->{search}/$regex->{replace}/ig; |
553 |
} |
554 |
elsif ( $modifiers eq 'i' ) { |
555 |
$value =~ s/$regex->{search}/$regex->{replace}/i; |
556 |
} |
557 |
elsif ( $modifiers eq 'g' ) { |
558 |
$value =~ s/$regex->{search}/$regex->{replace}/g; |
559 |
} |
560 |
else { |
561 |
$value =~ s/$regex->{search}/$regex->{replace}/; |
562 |
} |
563 |
} |
564 |
} |
565 |
return @$values; |
566 |
} |
340 |
1; |
567 |
1; |
341 |
__END__ |
568 |
__END__ |
342 |
- |
|
|