Lines 73-185
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 |
for ( $modifiers ) { |
100 |
record => $record, |
101 |
when ( /^(ig|gi)$/ ) { |
101 |
from_field => $fromFieldName, |
102 |
$value =~ s/$regex->{search}/$regex->{replace}/ig; |
102 |
from_subfield => $fromSubfieldName, |
103 |
} |
103 |
to_field => $toFieldName, |
104 |
when ( /^i$/ ) { |
104 |
to_subfield => $toSubfieldName, |
105 |
$value =~ s/$regex->{search}/$regex->{replace}/i; |
105 |
regex => $regex, |
106 |
} |
106 |
n => $n |
107 |
when ( /^g$/ ) { |
107 |
}); |
108 |
$value =~ s/$regex->{search}/$regex->{replace}/g; |
|
|
109 |
} |
110 |
default { |
111 |
$value =~ s/$regex->{search}/$regex->{replace}/; |
112 |
} |
113 |
} |
114 |
} |
108 |
} |
115 |
} |
|
|
116 |
update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => $dont_erase, values => \@values }); |
117 |
} |
118 |
|
119 |
=head2 update_field |
120 |
|
109 |
|
121 |
update_field( $record, $fieldName, $subfieldName, $dont_erase, $value[, $value,[ $value ... ] ] ); |
110 |
} |
122 |
|
|
|
123 |
Updates a field with the given value, creating it if neccessary. |
124 |
|
125 |
If multiple values are supplied, they will be used to update a list of repeatable fields |
126 |
until either the fields or the values are all used. |
127 |
|
111 |
|
128 |
If a single value is supplied for a repeated field, that value will be used to update |
112 |
sub _copy_field { |
129 |
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 |
} |
130 |
|
128 |
|
131 |
=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 |
} |
132 |
|
145 |
|
133 |
sub update_field { |
146 |
sub update_field { |
134 |
my ( $params ) = @_; |
147 |
my ( $params ) = @_; |
135 |
my $record = $params->{record}; |
148 |
my $record = $params->{record}; |
136 |
my $fieldName = $params->{field}; |
149 |
my $fieldName = $params->{field}; |
137 |
my $subfieldName = $params->{subfield}; |
150 |
my $subfieldName = $params->{subfield}; |
138 |
my $dont_erase = $params->{dont_erase}; |
151 |
my @values = @{ $params->{values} }; |
139 |
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 |
} |
140 |
|
163 |
|
141 |
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} }; |
142 |
|
169 |
|
143 |
my $i = 0; |
170 |
my $i = 0; |
144 |
my $field; |
|
|
145 |
if ( $subfieldName ) { |
146 |
if ( my @fields = $record->field( $fieldName ) ) { |
171 |
if ( my @fields = $record->field( $fieldName ) ) { |
147 |
unless ( $dont_erase ) { |
|
|
148 |
@values = ($values[0]) x scalar( @fields ) |
172 |
@values = ($values[0]) x scalar( @fields ) |
149 |
if @values == 1; |
173 |
if @values == 1; |
150 |
foreach my $field ( @fields ) { |
|
|
151 |
$field->update( "$subfieldName" => $values[$i++] ); |
152 |
} |
153 |
} |
154 |
if ( $i <= scalar ( @values ) - 1 ) { |
155 |
foreach my $field ( @fields ) { |
174 |
foreach my $field ( @fields ) { |
156 |
foreach my $j ( $i .. scalar( @values ) - 1) { |
175 |
$field->update( $values[$i++] ); |
157 |
$field->add_subfields( "$subfieldName" => $values[$j] ); |
|
|
158 |
} |
159 |
} |
176 |
} |
160 |
} |
|
|
161 |
} else { |
177 |
} else { |
162 |
## Field does not exist, create it. |
178 |
## Field does not exists, create it |
163 |
foreach my $value ( @values ) { |
179 |
if ( $fieldName < 10 ) { |
164 |
$field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] ); |
180 |
foreach my $value ( @values ) { |
165 |
$record->append_fields( $field ); |
181 |
my $field = MARC::Field->new( $fieldName, $value ); |
166 |
} |
182 |
$record->append_fields( $field ); |
|
|
183 |
} |
184 |
} else { |
185 |
warn "Invalid operation, trying to add a new field without subfield"; |
186 |
} |
167 |
} |
187 |
} |
168 |
} 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 |
|
169 |
if ( my @fields = $record->field( $fieldName ) ) { |
199 |
if ( my @fields = $record->field( $fieldName ) ) { |
170 |
@values = ($values[0]) x scalar( @fields ) |
200 |
unless ( $dont_erase ) { |
171 |
if @values == 1; |
201 |
@values = ($values[0]) x scalar( @fields ) |
172 |
foreach my $field ( @fields ) { |
202 |
if @values == 1; |
173 |
$field->update( $values[$i++] ); |
203 |
foreach my $field ( @fields ) { |
174 |
} |
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 |
} |
175 |
} else { |
214 |
} else { |
176 |
## Field does not exists, create it |
215 |
## Field does not exist, create it. |
177 |
foreach my $value ( @values ) { |
216 |
foreach my $value ( @values ) { |
178 |
$field = MARC::Field->new( $fieldName, $value ); |
217 |
my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] ); |
179 |
$record->append_fields( $field ); |
218 |
$record->append_fields( $field ); |
180 |
} |
219 |
} |
181 |
} |
220 |
} |
182 |
} |
|
|
183 |
} |
221 |
} |
184 |
|
222 |
|
185 |
=head2 read_field |
223 |
=head2 read_field |
Lines 194-220
sub update_field {
Link Here
|
194 |
=cut |
232 |
=cut |
195 |
|
233 |
|
196 |
sub read_field { |
234 |
sub read_field { |
197 |
my ( $params ) = @_; |
235 |
my ( $params ) = @_; |
198 |
my $record = $params->{record}; |
236 |
my $record = $params->{record}; |
199 |
my $fieldName = $params->{field}; |
237 |
my $fieldName = $params->{field}; |
200 |
my $subfieldName = $params->{subfield}; |
238 |
my $subfieldName = $params->{subfield}; |
201 |
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 |
} |
202 |
|
247 |
|
203 |
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}; |
204 |
|
253 |
|
205 |
return map { $_->data() } @fields unless $subfieldName; |
254 |
my @fields = $record->field( $fieldName ); |
206 |
|
255 |
|
207 |
my @subfields; |
256 |
return unless @fields; |
208 |
foreach my $field ( @fields ) { |
|
|
209 |
my @sf = $field->subfield( $subfieldName ); |
210 |
push( @subfields, @sf ); |
211 |
} |
212 |
|
257 |
|
213 |
if ( $n ) { |
258 |
return map { $_->data() } @fields |
214 |
return $subfields[$n-1]; |
259 |
if $fieldName < 10; |
215 |
} else { |
260 |
|
216 |
return @subfields; |
261 |
my @values; |
217 |
} |
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; |
218 |
} |
299 |
} |
219 |
|
300 |
|
220 |
=head2 field_exists |
301 |
=head2 field_exists |
Lines 293-314
sub field_equals {
Link Here
|
293 |
=cut |
374 |
=cut |
294 |
|
375 |
|
295 |
sub move_field { |
376 |
sub move_field { |
296 |
my ( $params ) = @_; |
377 |
my ( $params ) = @_; |
297 |
my $record = $params->{record}; |
378 |
my $record = $params->{record}; |
298 |
my $fromFieldName = $params->{from_field}; |
379 |
my $fromFieldName = $params->{from_field}; |
299 |
my $fromSubfieldName = $params->{from_subfield}; |
380 |
my $fromSubfieldName = $params->{from_subfield}; |
300 |
my $toFieldName = $params->{to_field}; |
381 |
my $toFieldName = $params->{to_field}; |
301 |
my $toSubfieldName = $params->{to_subfield}; |
382 |
my $toSubfieldName = $params->{to_subfield}; |
302 |
my $regex = $params->{regex}; |
383 |
my $regex = $params->{regex}; |
303 |
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 |
} |
408 |
|
409 |
sub _move_field { |
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 |
}); |
424 |
} |
304 |
|
425 |
|
305 |
copy_field({ record => $record, from_field => $fromFieldName, from_subfield => $fromSubfieldName, to_field => $toFieldName, to_subfield => $toSubfieldName, regex => $regex, n => $n , dont_erase => 1 }); |
426 |
sub _move_subfield { |
306 |
delete_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName, n => $n }); |
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 |
}); |
307 |
} |
449 |
} |
308 |
|
450 |
|
309 |
=head2 delete_field |
451 |
=head2 _delete_field |
310 |
|
452 |
|
311 |
delete_field( $record, $fieldName[, $subfieldName [, $n ] ] ); |
453 |
_delete_field( $record, $fieldName[, $subfieldName [, $n ] ] ); |
312 |
|
454 |
|
313 |
Deletes the given field. |
455 |
Deletes the given field. |
314 |
|
456 |
|
Lines 318-343
sub move_field {
Link Here
|
318 |
=cut |
460 |
=cut |
319 |
|
461 |
|
320 |
sub delete_field { |
462 |
sub delete_field { |
321 |
my ( $params ) = @_; |
463 |
my ( $params ) = @_; |
322 |
my $record = $params->{record}; |
464 |
my $record = $params->{record}; |
323 |
my $fieldName = $params->{field}; |
465 |
my $fieldName = $params->{field}; |
324 |
my $subfieldName = $params->{subfield}; |
466 |
my $subfieldName = $params->{subfield}; |
325 |
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 |
} |
326 |
|
475 |
|
327 |
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}; |
328 |
|
481 |
|
329 |
@fields = ( $fields[$n-1] ) if ( $n ); |
482 |
my @fields = $record->field( $fieldName ); |
330 |
|
483 |
|
331 |
if ( @fields && !$subfieldName ) { |
484 |
@fields = ( $fields[$n-1] ) if ( $n ); |
332 |
foreach my $field ( @fields ) { |
485 |
foreach my $field ( @fields ) { |
333 |
$record->delete_field( $field ); |
486 |
$record->delete_field( $field ); |
334 |
} |
487 |
} |
335 |
} 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 |
|
336 |
foreach my $field ( @fields ) { |
501 |
foreach my $field ( @fields ) { |
337 |
$field->delete_subfield( code => $subfieldName ); |
502 |
$field->delete_subfield( code => $subfieldName ); |
338 |
} |
503 |
} |
339 |
} |
|
|
340 |
} |
504 |
} |
341 |
|
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 |
for ( $modifiers ) { |
552 |
when ( /^(ig|gi)$/ ) { |
553 |
$value =~ s/$regex->{search}/$regex->{replace}/ig; |
554 |
} |
555 |
when ( /^i$/ ) { |
556 |
$value =~ s/$regex->{search}/$regex->{replace}/i; |
557 |
} |
558 |
when ( /^g$/ ) { |
559 |
$value =~ s/$regex->{search}/$regex->{replace}/g; |
560 |
} |
561 |
default { |
562 |
$value =~ s/$regex->{search}/$regex->{replace}/; |
563 |
} |
564 |
} |
565 |
} |
566 |
} |
567 |
return @$values; |
568 |
} |
342 |
1; |
569 |
1; |
343 |
__END__ |
570 |
__END__ |
344 |
- |
|
|