View | Details | Raw Unified | Return to bug 11413
Collapse All | Expand All

(-)a/C4/MarcModificationTemplates.pm (-25 / +26 lines)
Lines 524-578 sub ModifyRecordWithTemplate { Link Here
524
        }
524
        }
525
525
526
        my $do = 1;
526
        my $do = 1;
527
        my $field_numbers = [ $field_number ];
527
        if ( $conditional ) {
528
        if ( $conditional ) {
528
            if ( $conditional_comparison eq 'exists' ) {
529
            if ( $conditional_comparison eq 'exists' ) {
529
                my $exists = field_exists({
530
                $field_numbers = field_exists({
530
                        record =>$record,
531
                        record => $record,
531
                        field => $conditional_field,
532
                        field => $conditional_field,
532
                        subfield => $conditional_subfield,
533
                        subfield => $conditional_subfield,
533
                    });
534
                    });
534
                $do = $conditional eq 'if'
535
                $do = $conditional eq 'if'
535
                    ? $exists
536
                    ? @$field_numbers
536
                    : not $exists;
537
                    : not @$field_numbers;
537
            }
538
            }
538
            elsif ( $conditional_comparison eq 'not_exists' ) {
539
            elsif ( $conditional_comparison eq 'not_exists' ) {
539
                my $exists = field_exists({
540
                $field_numbers = field_exists({
540
                        record => $record,
541
                        record => $record,
541
                        field => $conditional_field,
542
                        field => $conditional_field,
542
                        subfield => $conditional_subfield
543
                        subfield => $conditional_subfield
543
                    });
544
                    });
544
                $do = $conditional eq 'if'
545
                $do = $conditional eq 'if'
545
                    ? not $exists
546
                    ? not @$field_numbers
546
                    : $exists;
547
                    : @$field_numbers;
547
            }
548
            }
548
            elsif ( $conditional_comparison eq 'equals' ) {
549
            elsif ( $conditional_comparison eq 'equals' ) {
549
                my $equals = field_equals({
550
                $field_numbers = field_equals({
550
                    record => $record,
551
                    record => $record,
551
                    value => $conditional_value,
552
                    value => $conditional_value,
552
                    field => $conditional_field,
553
                    field => $conditional_field,
553
                    subfield => $conditional_subfield,
554
                    subfield => $conditional_subfield,
554
                    regex => $conditional_regex
555
                });
555
                });
556
                $do = $conditional eq 'if'
556
                $do = $conditional eq 'if'
557
                    ? $equals
557
                    ? @$field_numbers
558
                    : not $equals;
558
                    : not @$field_numbers;
559
            }
559
            }
560
            elsif ( $conditional_comparison eq 'not_equals' ) {
560
            elsif ( $conditional_comparison eq 'not_equals' ) {
561
                my $equals = field_equals({
561
                $field_numbers = field_equals({
562
                    record => $record,
562
                    record => $record,
563
                    value => $conditional_value,
564
                    field => $conditional_field,
563
                    field => $conditional_field,
565
                    subfield => $conditional_subfield,
564
                    subfield => $conditional_subfield
566
                    regex => $conditional_regex
567
                });
565
                });
568
                $do = $conditional eq 'if'
566
                $do = $conditional eq 'if'
569
                    ? not $equals
567
                    ? not @$field_numbers
570
                    : $equals;
568
                    : @$field_numbers;
571
            }
569
            }
572
        }
570
        }
573
571
574
        if ( $do ) {
572
        if ( $do ) {
575
            if ( $action eq 'copy_field' ) {
573
            @$field_numbers = ( $field_number )
574
                if $from_field ne $to_subfield
575
                    and $field_number;
576
            if ( $action eq 'copy_fields' ) {
576
                copy_field({
577
                copy_field({
577
                    record => $record,
578
                    record => $record,
578
                    from_field => $from_field,
579
                    from_field => $from_field,
Lines 584-602 sub ModifyRecordWithTemplate { Link Here
584
                        replace => $to_regex_replace,
585
                        replace => $to_regex_replace,
585
                        modifiers => $to_regex_modifiers
586
                        modifiers => $to_regex_modifiers
586
                    },
587
                    },
587
                    n => $field_number,
588
                    field_numbers => $field_numbers,
588
                });
589
                });
589
            }
590
            }
590
591
            elsif ( $action eq 'update_fields' ) {
591
            elsif ( $action eq 'copy_field' ) {
592
                update_field({
592
                update_field({
593
                    record => $record,
593
                    record => $record,
594
                    field => $from_field,
594
                    field => $from_field,
595
                    subfield => $from_subfield,
595
                    subfield => $from_subfield,
596
                    values => [ $field_value ],
596
                    values => [ $field_value ],
597
                    field_numbers => $field_numbers,
597
                });
598
                });
598
            }
599
            }
599
            elsif ( $action eq 'copy_field' ) {
600
            elsif ( $action eq 'move_fields' ) {
600
                move_field({
601
                move_field({
601
                    record => $record,
602
                    record => $record,
602
                    from_field => $from_field,
603
                    from_field => $from_field,
Lines 608-622 sub ModifyRecordWithTemplate { Link Here
608
                        replace => $to_regex_replace,
609
                        replace => $to_regex_replace,
609
                        modifiers => $to_regex_modifiers
610
                        modifiers => $to_regex_modifiers
610
                    },
611
                    },
611
                    n => $field_number,
612
                    field_numbers => $field_numbers,
612
                });
613
                });
613
            }
614
            }
614
            elsif ( $action eq 'copy_field' ) {
615
            elsif ( $action eq 'delete_field' ) {
615
                delete_field({
616
                delete_field({
616
                    record => $record,
617
                    record => $record,
617
                    field => $from_field,
618
                    field => $from_field,
618
                    subfield => $from_subfield,
619
                    subfield => $from_subfield,
619
                    n => $field_number,
620
                    field_numbers => $field_numbers,
620
                });
621
                });
621
            }
622
            }
622
        }
623
        }
(-)a/Koha/SimpleMARC.pm (-60 / +96 lines)
Lines 80-86 sub copy_field { Link Here
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 $field_numbers = $params->{field_numbers} // [];
84
84
85
    if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
85
    if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
86
86
Lines 93-99 sub copy_field { Link Here
93
            from_field => $fromFieldName,
93
            from_field => $fromFieldName,
94
            to_field => $toFieldName,
94
            to_field => $toFieldName,
95
            regex => $regex,
95
            regex => $regex,
96
            n => $n
96
            field_numbers => $field_numbers,
97
        });
97
        });
98
    } else {
98
    } else {
99
        _copy_subfield({
99
        _copy_subfield({
Lines 103-109 sub copy_field { Link Here
103
            to_field => $toFieldName,
103
            to_field => $toFieldName,
104
            to_subfield => $toSubfieldName,
104
            to_subfield => $toSubfieldName,
105
            regex => $regex,
105
            regex => $regex,
106
            n => $n
106
            field_numbers => $field_numbers,
107
        });
107
        });
108
    }
108
    }
109
109
Lines 115-128 sub _copy_field { Link Here
115
    my $fromFieldName = $params->{from_field};
115
    my $fromFieldName = $params->{from_field};
116
    my $toFieldName = $params->{to_field};
116
    my $toFieldName = $params->{to_field};
117
    my $regex = $params->{regex};
117
    my $regex = $params->{regex};
118
    my $n = $params->{n};
118
    my $field_numbers = $params->{field_numbers} // [];
119
119
120
    _copy_move_field({
120
    _copy_move_field({
121
        record => $record,
121
        record => $record,
122
        from_field => $fromFieldName,
122
        from_field => $fromFieldName,
123
        to_field => $toFieldName,
123
        to_field => $toFieldName,
124
        regex => $regex,
124
        regex => $regex,
125
        n => $n
125
        field_numbers => $field_numbers,
126
    });
126
    });
127
}
127
}
128
128
Lines 134-143 sub _copy_subfield { Link Here
134
    my $toFieldName = $params->{to_field};
134
    my $toFieldName = $params->{to_field};
135
    my $toSubfieldName = $params->{to_subfield};
135
    my $toSubfieldName = $params->{to_subfield};
136
    my $regex = $params->{regex};
136
    my $regex = $params->{regex};
137
    my $n = $params->{n};
137
    my $field_numbers = $params->{field_numbers} // [];
138
138
139
    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
139
    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
140
    @values = ( $values[$n-1] ) if ( $n );
140
    if ( @$field_numbers ) {
141
        @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
142
    }
141
    _modify_values({ values => \@values, regex => $regex });
143
    _modify_values({ values => \@values, regex => $regex });
142
144
143
    update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values });
145
    update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values });
Lines 149-154 sub update_field { Link Here
149
    my $fieldName = $params->{field};
151
    my $fieldName = $params->{field};
150
    my $subfieldName = $params->{subfield};
152
    my $subfieldName = $params->{subfield};
151
    my @values = @{ $params->{values} };
153
    my @values = @{ $params->{values} };
154
    my $field_numbers = $params->{field_numbers} // [];
152
155
153
    if ( ! ( $record && $fieldName ) ) { return; }
156
    if ( ! ( $record && $fieldName ) ) { return; }
154
157
Lines 157-163 sub update_field { Link Here
157
        die "This action is not implemented yet";
160
        die "This action is not implemented yet";
158
        #_update_field({ record => $record, field => $fieldName, values => \@values });
161
        #_update_field({ record => $record, field => $fieldName, values => \@values });
159
    } else {
162
    } else {
160
        _update_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, values => \@values });
163
        _update_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, values => \@values, field_numbers => $field_numbers });
161
    }
164
    }
162
}
165
}
163
166
Lines 194-202 sub _update_subfield { Link Here
194
    my $subfieldName = $params->{subfield};
197
    my $subfieldName = $params->{subfield};
195
    my @values = @{ $params->{values} };
198
    my @values = @{ $params->{values} };
196
    my $dont_erase = $params->{dont_erase};
199
    my $dont_erase = $params->{dont_erase};
200
    my $field_numbers = $params->{field_numbers} // [];
197
    my $i = 0;
201
    my $i = 0;
198
202
199
    if ( my @fields = $record->field( $fieldName ) ) {
203
    my @fields = $record->field( $fieldName );
204
205
    if ( @$field_numbers ) {
206
        @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
207
    }
208
209
    if ( @fields ) {
200
        unless ( $dont_erase ) {
210
        unless ( $dont_erase ) {
201
            @values = ($values[0]) x scalar( @fields )
211
            @values = ($values[0]) x scalar( @fields )
202
                if @values == 1;
212
                if @values == 1;
Lines 236-247 sub read_field { Link Here
236
    my $record = $params->{record};
246
    my $record = $params->{record};
237
    my $fieldName = $params->{field};
247
    my $fieldName = $params->{field};
238
    my $subfieldName = $params->{subfield};
248
    my $subfieldName = $params->{subfield};
239
    my $n = $params->{n};
249
    my $field_numbers = $params->{field_numbers} // [];
240
250
241
    if ( not $subfieldName or $subfieldName eq '' ) {
251
    if ( not $subfieldName or $subfieldName eq '' ) {
242
        _read_field({ record => $record, field => $fieldName, n => $n });
252
        _read_field({ record => $record, field => $fieldName, field_numbers => $field_numbers });
243
    } else {
253
    } else {
244
        _read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
254
        _read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
245
    }
255
    }
246
}
256
}
247
257
Lines 249-255 sub _read_field { Link Here
249
    my ( $params ) = @_;
259
    my ( $params ) = @_;
250
    my $record = $params->{record};
260
    my $record = $params->{record};
251
    my $fieldName = $params->{field};
261
    my $fieldName = $params->{field};
252
    my $n = $params->{n};
262
    my $field_numbers = $params->{field_numbers} // [];
253
263
254
    my @fields = $record->field( $fieldName );
264
    my @fields = $record->field( $fieldName );
255
265
Lines 259-268 sub _read_field { Link Here
259
        if $fieldName < 10;
269
        if $fieldName < 10;
260
270
261
    my @values;
271
    my @values;
262
    if ( $n ) {
272
    if ( @$field_numbers ) {
263
        if ( $n <= scalar( @fields ) ) {
273
        for my $field_number ( @$field_numbers ) {
264
            for my $sf ( $fields[$n - 1]->subfields ) {
274
            if ( $field_number <= scalar( @fields ) ) {
265
                push @values, $sf->[1];
275
                for my $sf ( $fields[$field_number - 1]->subfields ) {
276
                    push @values, $sf->[1];
277
                }
266
            }
278
            }
267
        }
279
        }
268
    } else {
280
    } else {
Lines 281-287 sub _read_subfield { Link Here
281
    my $record = $params->{record};
293
    my $record = $params->{record};
282
    my $fieldName = $params->{field};
294
    my $fieldName = $params->{field};
283
    my $subfieldName = $params->{subfield};
295
    my $subfieldName = $params->{subfield};
284
    my $n = $params->{n};
296
    my $field_numbers = $params->{field_numbers} // [];
285
297
286
    my @fields = $record->field( $fieldName );
298
    my @fields = $record->field( $fieldName );
287
299
Lines 293-308 sub _read_subfield { Link Here
293
        push( @values, @sf );
305
        push( @values, @sf );
294
    }
306
    }
295
307
296
    return $n
308
    if ( @values and @$field_numbers ) {
297
        ? $values[$n-1]
309
        @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
298
        : @values;
310
    }
311
312
    return @values;
299
}
313
}
300
314
301
=head2 field_exists
315
=head2 field_exists
302
316
303
  $bool = field_exists( $record, $fieldName[, $subfieldName ]);
317
  @field_numbers = field_exists( $record, $fieldName[, $subfieldName ]);
304
318
305
  Returns true if the field exits, false otherwise.
319
  Returns the field numbers or an empty array.
306
320
307
=cut
321
=cut
308
322
Lines 314-341 sub field_exists { Link Here
314
328
315
  if ( ! $record ) { return; }
329
  if ( ! $record ) { return; }
316
330
317
  my $return = 0;
331
  my @field_numbers = ();
318
  if ( $fieldName && $subfieldName ) {
332
  my $current_field_number = 1;
319
    $return = $record->field( $fieldName ) && $record->subfield( $fieldName, $subfieldName );
333
  for my $field ( $record->field( $fieldName ) ) {
320
  } elsif ( $fieldName ) {
334
    if ( $subfieldName ) {
321
    $return = $record->field( $fieldName ) && 1;
335
      push @field_numbers, $current_field_number
336
        if $field->subfield( $subfieldName );
337
    } else {
338
      push @field_numbers, $current_field_number;
339
    }
340
    $current_field_number++;
322
  }
341
  }
323
342
324
  return $return;
343
  return \@field_numbers;
325
}
344
}
326
345
327
=head2 field_equals
346
=head2 field_equals
328
347
329
  $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
348
  $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex ] ]);
330
349
331
  Returns true if the field equals the given value, false otherwise.
350
  Returns true if the field equals the given value, false otherwise.
332
351
333
  If a regular expression ( $regex ) is supplied, the value will be compared using
352
  If a regular expression ( $regex ) is supplied, the value will be compared using
334
  the given regex. Example: $regex = 'sought_text'
353
  the given regex. Example: $regex = 'sought_text'
335
354
336
  If $n is passed, the Nth field of a repeatable series will be used for comparison.
337
  Set $n to 1 or leave empty for a non-repeatable field.
338
339
=cut
355
=cut
340
356
341
sub field_equals {
357
sub field_equals {
Lines 345-363 sub field_equals { Link Here
345
  my $fieldName = $params->{field};
361
  my $fieldName = $params->{field};
346
  my $subfieldName = $params->{subfield};
362
  my $subfieldName = $params->{subfield};
347
  my $regex = $params->{regex};
363
  my $regex = $params->{regex};
348
  my $n = $params->{n};
349
  $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
350
364
351
  if ( ! $record ) { return; }
365
  if ( ! $record ) { return; }
352
366
353
  my @field_values = read_field({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
367
  my @field_numbers = ();
354
  my $field_value = $field_values[$n-1];
368
  my $current_field_number = 1;
355
369
  FIELDS: for my $field ( $record->field( $fieldName ) ) {
356
  if ( $regex ) {
370
    my @subfield_values = $subfieldName
357
    return $field_value =~ m/$value/;
371
        ? $field->subfield( $subfieldName )
358
  } else {
372
        : map { $_->[1] } $field->subfields;
359
    return $field_value eq $value;
373
374
    SUBFIELDS: for my $subfield_value ( @subfield_values ) {
375
      if (
376
          (
377
              $regex and $subfield_value =~ m/$value/
378
          ) or (
379
              $subfield_value eq $value
380
          )
381
      ) {
382
          push @field_numbers, $current_field_number;
383
          last SUBFIELDS;
384
      }
385
    }
386
    $current_field_number++;
360
  }
387
  }
388
389
  return \@field_numbers;
361
}
390
}
362
391
363
=head2 move_field
392
=head2 move_field
Lines 381-387 sub move_field { Link Here
381
    my $toFieldName = $params->{to_field};
410
    my $toFieldName = $params->{to_field};
382
    my $toSubfieldName = $params->{to_subfield};
411
    my $toSubfieldName = $params->{to_subfield};
383
    my $regex = $params->{regex};
412
    my $regex = $params->{regex};
384
    my $n = $params->{n};
413
    my $field_numbers = $params->{field_numbers} // [];
385
414
386
    if ( not $fromSubfieldName or $fromSubfieldName eq ''
415
    if ( not $fromSubfieldName or $fromSubfieldName eq ''
387
        or not $toSubfieldName or $toSubfieldName eq ''
416
        or not $toSubfieldName or $toSubfieldName eq ''
Lines 391-397 sub move_field { Link Here
391
            from_field => $fromFieldName,
420
            from_field => $fromFieldName,
392
            to_field => $toFieldName,
421
            to_field => $toFieldName,
393
            regex => $regex,
422
            regex => $regex,
394
            n => $n,
423
            field_numbers => $field_numbers,
395
        });
424
        });
396
    } else {
425
    } else {
397
        _move_subfield({
426
        _move_subfield({
Lines 401-407 sub move_field { Link Here
401
            to_field => $toFieldName,
430
            to_field => $toFieldName,
402
            to_subfield => $toSubfieldName,
431
            to_subfield => $toSubfieldName,
403
            regex => $regex,
432
            regex => $regex,
404
            n => $n,
433
            field_numbers => $field_numbers,
405
        });
434
        });
406
    }
435
    }
407
}
436
}
Lines 412-424 sub _move_field { Link Here
412
    my $fromFieldName = $params->{from_field};
441
    my $fromFieldName = $params->{from_field};
413
    my $toFieldName = $params->{to_field};
442
    my $toFieldName = $params->{to_field};
414
    my $regex = $params->{regex};
443
    my $regex = $params->{regex};
415
    my $n = $params->{n};
444
    my $field_numbers = $params->{field_numbers} // [];
445
416
    _copy_move_field({
446
    _copy_move_field({
417
        record => $record,
447
        record => $record,
418
        from_field => $fromFieldName,
448
        from_field => $fromFieldName,
419
        to_field => $toFieldName,
449
        to_field => $toFieldName,
420
        regex => $regex,
450
        regex => $regex,
421
        n => $n,
451
        field_numbers => $field_numbers,
422
        action => 'move',
452
        action => 'move',
423
    });
453
    });
424
}
454
}
Lines 431-441 sub _move_subfield { Link Here
431
    my $toFieldName = $params->{to_field};
461
    my $toFieldName = $params->{to_field};
432
    my $toSubfieldName = $params->{to_subfield};
462
    my $toSubfieldName = $params->{to_subfield};
433
    my $regex = $params->{regex};
463
    my $regex = $params->{regex};
434
    my $n = $params->{n};
464
    my $field_numbers = $params->{field_numbers} // [];
435
465
436
    # Copy
466
    # Copy
437
    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
467
    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
438
    @values = ( $values[$n-1] ) if $n;
468
    if ( @$field_numbers ) {
469
        @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
470
    }
439
    _modify_values({ values => \@values, regex => $regex });
471
    _modify_values({ values => \@values, regex => $regex });
440
    _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => 1, values => \@values });
472
    _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => 1, values => \@values });
441
473
Lines 444-450 sub _move_subfield { Link Here
444
        record => $record,
476
        record => $record,
445
        field => $fromFieldName,
477
        field => $fromFieldName,
446
        subfield => $fromSubfieldName,
478
        subfield => $fromSubfieldName,
447
        n => $n,
479
        field_numbers => $field_numbers,
448
    });
480
    });
449
}
481
}
450
482
Lines 464-475 sub delete_field { Link Here
464
    my $record = $params->{record};
496
    my $record = $params->{record};
465
    my $fieldName = $params->{field};
497
    my $fieldName = $params->{field};
466
    my $subfieldName = $params->{subfield};
498
    my $subfieldName = $params->{subfield};
467
    my $n = $params->{n};
499
    my $field_numbers = $params->{field_numbers} // [];
468
500
469
    if ( not $subfieldName or $subfieldName eq '' ) {
501
    if ( not $subfieldName or $subfieldName eq '' ) {
470
        _delete_field({ record => $record, field => $fieldName, n => $n });
502
        _delete_field({ record => $record, field => $fieldName, field_numbers => $field_numbers });
471
    } else {
503
    } else {
472
        _delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
504
        _delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, field_numbers => $field_numbers });
473
    }
505
    }
474
}
506
}
475
507
Lines 477-487 sub _delete_field { Link Here
477
    my ( $params ) = @_;
509
    my ( $params ) = @_;
478
    my $record = $params->{record};
510
    my $record = $params->{record};
479
    my $fieldName = $params->{field};
511
    my $fieldName = $params->{field};
480
    my $n = $params->{n};
512
    my $field_numbers = $params->{field_numbers} // [];
481
513
482
    my @fields = $record->field( $fieldName );
514
    my @fields = $record->field( $fieldName );
483
515
484
    @fields = ( $fields[$n-1] ) if ( $n );
516
    if ( @$field_numbers ) {
517
        @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
518
    }
485
    foreach my $field ( @fields ) {
519
    foreach my $field ( @fields ) {
486
        $record->delete_field( $field );
520
        $record->delete_field( $field );
487
    }
521
    }
Lines 492-502 sub _delete_subfield { Link Here
492
    my $record = $params->{record};
526
    my $record = $params->{record};
493
    my $fieldName = $params->{field};
527
    my $fieldName = $params->{field};
494
    my $subfieldName = $params->{subfield};
528
    my $subfieldName = $params->{subfield};
495
    my $n = $params->{n};
529
    my $field_numbers = $params->{field_numbers} // [];
496
530
497
    my @fields = $record->field( $fieldName );
531
    my @fields = $record->field( $fieldName );
498
532
499
    @fields = ( $fields[$n-1] ) if ( $n );
533
    if ( @$field_numbers ) {
534
        @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
535
    }
500
536
501
    foreach my $field ( @fields ) {
537
    foreach my $field ( @fields ) {
502
        $field->delete_subfield( code => $subfieldName );
538
        $field->delete_subfield( code => $subfieldName );
Lines 510-521 sub _copy_move_field { Link Here
510
    my $fromFieldName = $params->{from_field};
546
    my $fromFieldName = $params->{from_field};
511
    my $toFieldName = $params->{to_field};
547
    my $toFieldName = $params->{to_field};
512
    my $regex = $params->{regex};
548
    my $regex = $params->{regex};
513
    my $n = $params->{n};
549
    my $field_numbers = $params->{field_numbers};
514
    my $action = $params->{action} || 'copy';
550
    my $action = $params->{action} || 'copy';
515
551
516
    my @fields = $record->field( $fromFieldName );
552
    my @fields = $record->field( $fromFieldName );
517
    if ( $n and $n <= scalar( @fields ) ) {
553
    if ( @$field_numbers ) {
518
        @fields = ( $fields[$n - 1] );
554
        @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
519
    }
555
    }
520
556
521
    for my $field ( @fields ) {
557
    for my $field ( @fields ) {
(-)a/t/SimpleMARC.t (-106 / +197 lines)
Lines 41-54 sub new_record { Link Here
41
subtest 'field_exists' => sub {
41
subtest 'field_exists' => sub {
42
    plan tests => 3;
42
    plan tests => 3;
43
    my $record = new_record;
43
    my $record = new_record;
44
    is(
44
    is_deeply(
45
        field_exists( { record => $record, field => '650', subfield => 'a' } ),
45
        field_exists( { record => $record, field => '650', subfield => 'a' } ),
46
        'Computer programming.',
46
        [1],
47
        '650$a exists'
47
        '650$a exists'
48
    );
48
    );
49
    is(
49
    is_deeply(
50
        field_exists( { record => $record, field => '650', subfield => 'b' } ),
50
        field_exists( { record => $record, field => '650', subfield => 'b' } ),
51
        undef,
51
        [],
52
        '650$b does not exist'
52
        '650$b does not exist'
53
    );
53
    );
54
54
Lines 60-69 subtest 'field_exists' => sub { Link Here
60
        )
60
        )
61
    );
61
    );
62
62
63
    is(
63
    is_deeply(
64
        field_exists( { record => $record, field => '650', subfield => 'a' } ),
64
        field_exists( { record => $record, field => '650', subfield => 'a' } ),
65
        'Computer programming.',
65
        [ 1, 2 ],
66
        '650$a exists, field_exists returns the first one'
66
        '650$a exists, field_exists returns the 2 field numbers'
67
    );
67
    );
68
};
68
};
69
69
Lines 83-124 subtest 'read_field' => sub { Link Here
83
83
84
        my @fields_650a =
84
        my @fields_650a =
85
          read_field( { record => $record, field => '650', subfield => 'a' } );
85
          read_field( { record => $record, field => '650', subfield => 'a' } );
86
        is( $fields_650a[0], 'Computer programming.', 'first 650$a' );
86
        is_deeply( $fields_650a[0], 'Computer programming.', 'first 650$a' );
87
        is( $fields_650a[1], 'Computer algorithms.',  'second 650$a' );
87
        is_deeply( $fields_650a[1], 'Computer algorithms.',  'second 650$a' );
88
        is(
88
        is_deeply(
89
            read_field(
89
            [
90
                {
90
                read_field(
91
                    record   => $record,
91
                    {
92
                    field    => '650',
92
                        record        => $record,
93
                    subfield => 'a',
93
                        field         => '650',
94
                    n        => 1
94
                        subfield      => 'a',
95
                }
95
                        field_numbers => [1]
96
            ),
96
                    }
97
            'Computer programming.',
97
                )
98
            ],
99
            ['Computer programming.'],
98
            'first 650$a bis'
100
            'first 650$a bis'
99
        );
101
        );
100
        is(
102
        is_deeply(
101
            read_field(
103
            [
102
                {
104
                read_field(
103
                    record   => $record,
105
                    {
104
                    field    => '650',
106
                        record        => $record,
105
                    subfield => 'a',
107
                        field         => '650',
106
                    n        => 2
108
                        subfield      => 'a',
107
                }
109
                        field_numbers => [2]
108
            ),
110
                    }
109
            'Computer algorithms.',
111
                )
112
            ],
113
            ['Computer algorithms.'],
110
            'second 650$a bis'
114
            'second 650$a bis'
111
        );
115
        );
112
        is(
116
        is_deeply(
113
            read_field(
117
            [
114
                {
118
                read_field(
115
                    record   => $record,
119
                    {
116
                    field    => '650',
120
                        record        => $record,
117
                    subfield => 'a',
121
                        field         => '650',
118
                    n        => 3
122
                        subfield      => 'a',
119
                }
123
                        field_numbers => [3]
120
            ),
124
                    }
121
            undef,
125
                )
126
            ],
127
            [],
122
            'There is no 3 650$a'
128
            'There is no 3 650$a'
123
        );
129
        );
124
    };
130
    };
Lines 148-156 subtest 'read_field' => sub { Link Here
148
            [
154
            [
149
                read_field(
155
                read_field(
150
                    {
156
                    {
151
                        record => $record,
157
                        record        => $record,
152
                        field  => '650',
158
                        field         => '650',
153
                        n      => 1
159
                        field_numbers => [1]
154
                    }
160
                    }
155
                )
161
                )
156
            ],
162
            ],
Lines 158-169 subtest 'read_field' => sub { Link Here
158
            'Get the all subfield values for the first field 650'
164
            'Get the all subfield values for the first field 650'
159
        );
165
        );
160
        is_deeply(
166
        is_deeply(
161
            [ read_field( { record => $record, field => '650', n => 2 } ) ],
167
            [
168
                read_field(
169
                    { record => $record, field => '650', field_numbers => [2] }
170
                )
171
            ],
162
            [ 'Computer algorithms.', '463' ],
172
            [ 'Computer algorithms.', '463' ],
163
            'Get the all subfield values for the second field 650'
173
            'Get the all subfield values for the second field 650'
164
        );
174
        );
165
        is_deeply(
175
        is_deeply(
166
            [ read_field( { record => $record, field => '650', n => 3 } ) ],
176
            [
177
                read_field(
178
                    { record => $record, field => '650', field_numbers => [3] }
179
                )
180
            ],
167
            [],
181
            [],
168
'Get the all subfield values for the third field 650 which does not exist'
182
'Get the all subfield values for the third field 650 which does not exist'
169
        );
183
        );
Lines 186-195 subtest 'update_field' => sub { Link Here
186
            }
200
            }
187
        );
201
        );
188
        is_deeply(
202
        is_deeply(
189
            read_field(
203
            [
190
                { record => $record, field => '952', subfield => 'p' }
204
                read_field(
191
            ),
205
                    { record => $record, field => '952', subfield => 'p' }
192
            '3010023918',
206
                )
207
            ],
208
            ['3010023918'],
193
            'update existing subfield 952$p'
209
            'update existing subfield 952$p'
194
        );
210
        );
195
        delete_field( { record => $record, field => '952' } );
211
        delete_field( { record => $record, field => '952' } );
Lines 210-219 subtest 'update_field' => sub { Link Here
210
            }
226
            }
211
        );
227
        );
212
        is_deeply(
228
        is_deeply(
213
            read_field(
229
            [
214
                { record => $record, field => '952', subfield => 'p' }
230
                read_field(
215
            ),
231
                    { record => $record, field => '952', subfield => 'p' }
216
            '3010023918',
232
                )
233
            ],
234
            ['3010023918'],
217
            'create subfield 952$p'
235
            'create subfield 952$p'
218
        );
236
        );
219
        is_deeply(
237
        is_deeply(
Lines 288-312 subtest 'copy_field' => sub { Link Here
288
            }
306
            }
289
        );
307
        );
290
        is_deeply(
308
        is_deeply(
291
            read_field(
309
            [
292
                { record => $record, field => '245', subfield => 'a' }
310
                read_field(
293
            ),
311
                    { record => $record, field => '245', subfield => 'a' }
294
            'The art of computer programming',
312
                )
313
            ],
314
            ['The art of computer programming'],
295
            'After copy 245$a still exists'
315
            'After copy 245$a still exists'
296
        );
316
        );
297
        is_deeply(
317
        is_deeply(
298
            read_field(
318
            [
299
                { record => $record, field => '246', subfield => 'a' }
319
                read_field(
300
            ),
320
                    { record => $record, field => '246', subfield => 'a' }
301
            'The art of computer programming',
321
                )
322
            ],
323
            ['The art of computer programming'],
302
            '246$a is a new field'
324
            '246$a is a new field'
303
        );
325
        );
304
        delete_field( { record => $record, field => '246' } );
326
        delete_field( { record => $record, field => '246' } );
305
        is(
327
        is_deeply(
306
            field_exists(
328
            field_exists(
307
                { record => $record, field => '246', subfield => 'a' }
329
                { record => $record, field => '246', subfield => 'a' }
308
            ),
330
            ),
309
            undef,
331
            [],
310
            '246$a does not exist anymore'
332
            '246$a does not exist anymore'
311
        );
333
        );
312
334
Lines 335-348 subtest 'copy_field' => sub { Link Here
335
                from_subfield => 'a',
357
                from_subfield => 'a',
336
                to_field      => '651',
358
                to_field      => '651',
337
                to_subfield   => 'a',
359
                to_subfield   => 'a',
338
                n             => 1
360
                field_numbers => [1]
339
            }
361
            }
340
        );
362
        );
341
        is_deeply(
363
        is_deeply(
342
            read_field(
364
            [
343
                { record => $record, field => '651', subfield => 'a' }
365
                read_field(
344
            ),
366
                    { record => $record, field => '651', subfield => 'a' }
345
            'Computer programming.',
367
                )
368
            ],
369
            ['Computer programming.'],
346
            'Copy first field 650$a'
370
            'Copy first field 650$a'
347
        );
371
        );
348
        delete_field( { record => $record, field => '652' } );
372
        delete_field( { record => $record, field => '652' } );
Lines 354-367 subtest 'copy_field' => sub { Link Here
354
                from_subfield => 'a',
378
                from_subfield => 'a',
355
                to_field      => '651',
379
                to_field      => '651',
356
                to_subfield   => 'a',
380
                to_subfield   => 'a',
357
                n             => 2
381
                field_numbers => [2]
358
            }
382
            }
359
        );
383
        );
360
        is_deeply(
384
        is_deeply(
361
            read_field(
385
            [
362
                { record => $record, field => '651', subfield => 'a' }
386
                read_field(
363
            ),
387
                    { record => $record, field => '651', subfield => 'a' }
364
            'Computer algorithms.',
388
                )
389
            ],
390
            ['Computer algorithms.'],
365
            'Copy second field 650$a'
391
            'Copy second field 650$a'
366
        );
392
        );
367
        delete_field( { record => $record, field => '651' } );
393
        delete_field( { record => $record, field => '651' } );
Lines 430-436 subtest 'copy_field' => sub { Link Here
430
                to_field      => '651',
456
                to_field      => '651',
431
                to_subfield   => 'a',
457
                to_subfield   => 'a',
432
                regex => { search => 'Computer', replace => 'The art of' },
458
                regex => { search => 'Computer', replace => 'The art of' },
433
                n     => 1
459
                field_numbers => [1]
434
            }
460
            }
435
        );
461
        );
436
        @fields_651a =
462
        @fields_651a =
Lines 574-583 subtest 'copy_field' => sub { Link Here
574
            }
600
            }
575
        );
601
        );
576
        is_deeply(
602
        is_deeply(
577
            read_field(
603
            [
578
                { record => $record, field => '245', subfield => 'a' }
604
                read_field(
579
            ),
605
                    { record => $record, field => '245', subfield => 'a' }
580
            'BEGIN The art of computer programming',
606
                )
607
            ],
608
            ['BEGIN The art of computer programming'],
581
            'Update a subfield: add a string at the beginning'
609
            'Update a subfield: add a string at the beginning'
582
        );
610
        );
583
611
Lines 593-602 subtest 'copy_field' => sub { Link Here
593
            }
621
            }
594
        );
622
        );
595
        is_deeply(
623
        is_deeply(
596
            read_field(
624
            [
597
                { record => $record, field => '245', subfield => 'a' }
625
                read_field(
598
            ),
626
                    { record => $record, field => '245', subfield => 'a' }
599
            'The art of computer programming END',
627
                )
628
            ],
629
            ['The art of computer programming END'],
600
            'Update a subfield: add a string at the end'
630
            'Update a subfield: add a string at the end'
601
        );
631
        );
602
632
Lines 618-639 subtest 'copy_field' => sub { Link Here
618
            { record => $record, from_field => '952', to_field => '953' } );
648
            { record => $record, from_field => '952', to_field => '953' } );
619
        my @fields_952 = read_field( { record => $record, field => '952' } );
649
        my @fields_952 = read_field( { record => $record, field => '952' } );
620
        is_deeply(
650
        is_deeply(
621
            [ read_field( { record => $record, field => '952', n => 1 } ) ],
651
            [
652
                read_field(
653
                    { record => $record, field => '952', field_numbers => [1] }
654
                )
655
            ],
622
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
656
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
623
            "copy all: original first field still exists"
657
            "copy all: original first field still exists"
624
        );
658
        );
625
        is_deeply(
659
        is_deeply(
626
            [ read_field( { record => $record, field => '952', n => 2 } ) ],
660
            [
661
                read_field(
662
                    { record => $record, field => '952', field_numbers => [2] }
663
                )
664
            ],
627
            [ '3010023918', 'CD' ],
665
            [ '3010023918', 'CD' ],
628
            "copy all: original second field still exists"
666
            "copy all: original second field still exists"
629
        );
667
        );
630
        is_deeply(
668
        is_deeply(
631
            [ read_field( { record => $record, field => '953', n => 1 } ) ],
669
            [
670
                read_field(
671
                    { record => $record, field => '953', field_numbers => [1] }
672
                )
673
            ],
632
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
674
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
633
            "copy all: first original fields has been copied"
675
            "copy all: first original fields has been copied"
634
        );
676
        );
635
        is_deeply(
677
        is_deeply(
636
            [ read_field( { record => $record, field => '953', n => 2 } ) ],
678
            [
679
                read_field(
680
                    { record => $record, field => '953', field_numbers => [2] }
681
                )
682
            ],
637
            [ '3010023918', 'CD' ],
683
            [ '3010023918', 'CD' ],
638
            "copy all: second original fields has been copied"
684
            "copy all: second original fields has been copied"
639
        );
685
        );
Lines 641-659 subtest 'copy_field' => sub { Link Here
641
        #- copy only the first field
687
        #- copy only the first field
642
        copy_field(
688
        copy_field(
643
            {
689
            {
644
                record     => $record,
690
                record        => $record,
645
                from_field => '953',
691
                from_field    => '953',
646
                to_field   => '954',
692
                to_field      => '954',
647
                n          => 1
693
                field_numbers => [1]
648
            }
694
            }
649
        );
695
        );
650
        is_deeply(
696
        is_deeply(
651
            [ read_field( { record => $record, field => '953', n => 1 } ) ],
697
            [
698
                read_field(
699
                    { record => $record, field => '953', field_numbers => [1] }
700
                )
701
            ],
652
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
702
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
653
            "copy first: first original fields has been copied"
703
            "copy first: first original fields has been copied"
654
        );
704
        );
655
        is_deeply(
705
        is_deeply(
656
            [ read_field( { record => $record, field => '953', n => 2 } ) ],
706
            [
707
                read_field(
708
                    { record => $record, field => '953', field_numbers => [2] }
709
                )
710
            ],
657
            [ '3010023918', 'CD' ],
711
            [ '3010023918', 'CD' ],
658
            "copy first: second original fields has been copied"
712
            "copy first: second original fields has been copied"
659
        );
713
        );
Lines 682-703 subtest 'copy_field' => sub { Link Here
682
            }
736
            }
683
        );
737
        );
684
        is_deeply(
738
        is_deeply(
685
            [ read_field( { record => $record, field => '952', n => 1 } ) ],
739
            [
740
                read_field(
741
                    { record => $record, field => '952', field_numbers => [1] }
742
                )
743
            ],
686
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
744
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
687
            "copy all with regex: original first field still exists"
745
            "copy all with regex: original first field still exists"
688
        );
746
        );
689
        is_deeply(
747
        is_deeply(
690
            [ read_field( { record => $record, field => '952', n => 2 } ) ],
748
            [
749
                read_field(
750
                    { record => $record, field => '952', field_numbers => [2] }
751
                )
752
            ],
691
            [ '3010023918', 'CD' ],
753
            [ '3010023918', 'CD' ],
692
            "copy all with regex: original second field still exists"
754
            "copy all with regex: original second field still exists"
693
        );
755
        );
694
        is_deeply(
756
        is_deeply(
695
            [ read_field( { record => $record, field => '953', n => 1 } ) ],
757
            [
758
                read_field(
759
                    { record => $record, field => '953', field_numbers => [1] }
760
                )
761
            ],
696
            [ '4242423917', 'BK', 'GEN', '2001-06-25' ],
762
            [ '4242423917', 'BK', 'GEN', '2001-06-25' ],
697
            "copy all wirh regex: first original fields has been copied"
763
            "copy all wirh regex: first original fields has been copied"
698
        );
764
        );
699
        is_deeply(
765
        is_deeply(
700
            [ read_field( { record => $record, field => '953', n => 2 } ) ],
766
            [
767
                read_field(
768
                    { record => $record, field => '953', field_numbers => [2] }
769
                )
770
            ],
701
            [ '4242423918', 'CD' ],
771
            [ '4242423918', 'CD' ],
702
            "copy all with regex: second original fields has been copied"
772
            "copy all with regex: second original fields has been copied"
703
        );
773
        );
Lines 752-758 subtest 'move_field' => sub { Link Here
752
                from_subfield => 'p',
822
                from_subfield => 'p',
753
                to_field      => '954',
823
                to_field      => '954',
754
                to_subfield   => 'p',
824
                to_subfield   => 'p',
755
                n             => 1
825
                field_numbers => [1]
756
            }
826
            }
757
        );    # Move the first field
827
        );    # Move the first field
758
        my @fields_952p =
828
        my @fields_952p =
Lines 825-836 subtest 'move_field' => sub { Link Here
825
        is_deeply( [ read_field( { record => $record, field => '952' } ) ],
895
        is_deeply( [ read_field( { record => $record, field => '952' } ) ],
826
            [], "original fields don't exist" );
896
            [], "original fields don't exist" );
827
        is_deeply(
897
        is_deeply(
828
            [ read_field( { record => $record, field => '953', n => 1 } ) ],
898
            [
899
                read_field(
900
                    { record => $record, field => '953', field_numbers => [1] }
901
                )
902
            ],
829
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
903
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
830
            "first original fields has been copied"
904
            "first original fields has been copied"
831
        );
905
        );
832
        is_deeply(
906
        is_deeply(
833
            [ read_field( { record => $record, field => '953', n => 2 } ) ],
907
            [
908
                read_field(
909
                    { record => $record, field => '953', field_numbers => [2] }
910
                )
911
            ],
834
            [ '3010023917', 'BK' ],
912
            [ '3010023917', 'BK' ],
835
            "second original fields has been copied"
913
            "second original fields has been copied"
836
        );
914
        );
Lines 838-847 subtest 'move_field' => sub { Link Here
838
        #- Move only the first field
916
        #- Move only the first field
839
        move_field(
917
        move_field(
840
            {
918
            {
841
                record     => $record,
919
                record        => $record,
842
                from_field => '953',
920
                from_field    => '953',
843
                to_field   => '954',
921
                to_field      => '954',
844
                n          => 1
922
                field_numbers => [1]
845
            }
923
            }
846
        );
924
        );
847
        is_deeply(
925
        is_deeply(
Lines 876-887 subtest 'move_field' => sub { Link Here
876
        is_deeply( [ read_field( { record => $record, field => '952' } ) ],
954
        is_deeply( [ read_field( { record => $record, field => '952' } ) ],
877
            [], "use a regex, original fields don't exist" );
955
            [], "use a regex, original fields don't exist" );
878
        is_deeply(
956
        is_deeply(
879
            [ read_field( { record => $record, field => '953', n => 1 } ) ],
957
            [
958
                read_field(
959
                    { record => $record, field => '953', field_numbers => [1] }
960
                )
961
            ],
880
            [ '3010023917', 'DVD', 'GEN', '2001-06-25' ],
962
            [ '3010023917', 'DVD', 'GEN', '2001-06-25' ],
881
            "use a regex, first original fields has been copied"
963
            "use a regex, first original fields has been copied"
882
        );
964
        );
883
        is_deeply(
965
        is_deeply(
884
            [ read_field( { record => $record, field => '953', n => 2 } ) ],
966
            [
967
                read_field(
968
                    { record => $record, field => '953', field_numbers => [2] }
969
                )
970
            ],
885
            [ '3010023917', 'DVD' ],
971
            [ '3010023917', 'DVD' ],
886
            "use a regex, second original fields has been copied"
972
            "use a regex, second original fields has been copied"
887
        );
973
        );
Lines 916-922 subtest 'delete_field' => sub { Link Here
916
        );
1002
        );
917
1003
918
        delete_field(
1004
        delete_field(
919
            { record => $record, field => '952', subfield => 'p', n => 1 } );
1005
            {
1006
                record        => $record,
1007
                field         => '952',
1008
                subfield      => 'p',
1009
                field_numbers => [1]
1010
            }
1011
        );
920
        my @fields_952p =
1012
        my @fields_952p =
921
          read_field( { record => $record, field => '952', subfield => 'p' } );
1013
          read_field( { record => $record, field => '952', subfield => 'p' } );
922
        is_deeply( \@fields_952p, ['3010023917'], 'Delete first 952$p' );
1014
        is_deeply( \@fields_952p, ['3010023917'], 'Delete first 952$p' );
923
- 

Return to bug 11413