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

(-)a/Koha/SimpleMARC.pm (-19 / +48 lines)
Lines 123-128 sub _copy_field { Link Here
123
        to_field => $toFieldName,
123
        to_field => $toFieldName,
124
        regex => $regex,
124
        regex => $regex,
125
        field_numbers => $field_numbers,
125
        field_numbers => $field_numbers,
126
        action => 'copy',
126
    });
127
    });
127
}
128
}
128
129
Lines 136-148 sub _copy_subfield { Link Here
136
    my $regex = $params->{regex};
137
    my $regex = $params->{regex};
137
    my $field_numbers = $params->{field_numbers} // [];
138
    my $field_numbers = $params->{field_numbers} // [];
138
139
139
    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
140
    _copy_move_subfield({
140
    if ( @$field_numbers ) {
141
        record => $record,
141
        @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
142
        from_field => $fromFieldName,
142
    }
143
        from_subfield => $fromSubfieldName,
143
    _modify_values({ values => \@values, regex => $regex });
144
        to_field => $toFieldName,
144
145
        to_subfield => $toSubfieldName,
145
    update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values });
146
        regex => $regex,
147
        field_numbers => $field_numbers,
148
        action => 'copy',
149
    });
146
}
150
}
147
151
148
sub update_field {
152
sub update_field {
Lines 463-482 sub _move_subfield { Link Here
463
    my $regex = $params->{regex};
467
    my $regex = $params->{regex};
464
    my $field_numbers = $params->{field_numbers} // [];
468
    my $field_numbers = $params->{field_numbers} // [];
465
469
466
    # Copy
470
    _copy_move_subfield({
467
    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
468
    if ( @$field_numbers ) {
469
        @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
470
    }
471
    _modify_values({ values => \@values, regex => $regex });
472
    _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => 1, values => \@values });
473
474
    # And delete
475
    _delete_subfield({
476
        record => $record,
471
        record => $record,
477
        field => $fromFieldName,
472
        from_field => $fromFieldName,
478
        subfield => $fromSubfieldName,
473
        from_subfield => $fromSubfieldName,
474
        to_field => $toFieldName,
475
        to_subfield => $toSubfieldName,
476
        regex => $regex,
479
        field_numbers => $field_numbers,
477
        field_numbers => $field_numbers,
478
        action => 'move',
480
    });
479
    });
481
}
480
}
482
481
Lines 570-575 sub _copy_move_field { Link Here
570
    }
569
    }
571
}
570
}
572
571
572
sub _copy_move_subfield {
573
    my ( $params ) = @_;
574
    my $record = $params->{record};
575
    my $fromFieldName = $params->{from_field};
576
    my $fromSubfieldName = $params->{from_subfield};
577
    my $toFieldName = $params->{to_field};
578
    my $toSubfieldName = $params->{to_subfield};
579
    my $regex = $params->{regex};
580
    my $field_numbers = $params->{field_numbers} // [];
581
    my $action = $params->{action} || 'copy';
582
583
    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
584
    if ( @$field_numbers ) {
585
        @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
586
    }
587
    _modify_values({ values => \@values, regex => $regex });
588
    my $dont_erase = $action eq 'copy' ? 1 : 0;
589
    _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values, dont_erase => $dont_erase });
590
591
    # And delete if it's a move
592
    if ( $action eq 'move' ) {
593
        _delete_subfield({
594
            record => $record,
595
            field => $fromFieldName,
596
            subfield => $fromSubfieldName,
597
            field_numbers => $field_numbers,
598
        });
599
    }
600
}
601
573
sub _modify_values {
602
sub _modify_values {
574
    my ( $params ) = @_;
603
    my ( $params ) = @_;
575
    my $values = $params->{values};
604
    my $values = $params->{values};
(-)a/t/SimpleMARC.t (-7 / +78 lines)
Lines 287-293 subtest 'update_field' => sub { Link Here
287
subtest 'copy_field' => sub {
287
subtest 'copy_field' => sub {
288
    plan tests              => 2;
288
    plan tests              => 2;
289
    subtest 'copy subfield' => sub {
289
    subtest 'copy subfield' => sub {
290
        plan tests => 18;
290
        plan tests => 20;
291
        my $record = new_record;
291
        my $record = new_record;
292
        $record->append_fields(
292
        $record->append_fields(
293
            MARC::Field->new(
293
            MARC::Field->new(
Lines 387-393 subtest 'copy_field' => sub { Link Here
387
                    { record => $record, field => '651', subfield => 'a' }
387
                    { record => $record, field => '651', subfield => 'a' }
388
                )
388
                )
389
            ],
389
            ],
390
            ['Computer algorithms.'],
390
            ['Computer programming.', 'Computer algorithms.'],
391
            'Copy second field 650$a'
391
            'Copy second field 650$a'
392
        );
392
        );
393
        delete_field( { record => $record, field => '651' } );
393
        delete_field( { record => $record, field => '651' } );
Lines 409-414 subtest 'copy_field' => sub { Link Here
409
            [ 'The art of programming.', 'The art of algorithms.' ],
409
            [ 'The art of programming.', 'The art of algorithms.' ],
410
            'Copy field using regex'
410
            'Copy field using regex'
411
        );
411
        );
412
        delete_field( { record => $record, field => '651' } );
412
413
413
        copy_field(
414
        copy_field(
414
            {
415
            {
Lines 549-554 subtest 'copy_field' => sub { Link Here
549
            'Copy field using regex'
550
            'Copy field using regex'
550
        );
551
        );
551
552
553
        $record = new_record;
552
        $record->append_fields(
554
        $record->append_fields(
553
            MARC::Field->new(
555
            MARC::Field->new(
554
                952, ' ', ' ',
556
                952, ' ', ' ',
Lines 568-576 subtest 'copy_field' => sub { Link Here
568
        );
570
        );
569
        my @fields_952d =
571
        my @fields_952d =
570
          read_field( { record => $record, field => '952', subfield => 'd' } );
572
          read_field( { record => $record, field => '952', subfield => 'd' } );
573
        # FIXME We need a new action "duplicate" if we don't want to modify the original field
571
        is_deeply(
574
        is_deeply(
572
            \@fields_952d,
575
            \@fields_952d,
573
            [ '2001-06-25', '2001-06-25' ],
576
            [ '2001-06-25', '2001-06-25', '2001-06-25' ],
574
            'copy 952$d into others 952 field'
577
            'copy 952$d into others 952 field'
575
        );
578
        );
576
579
Lines 605-611 subtest 'copy_field' => sub { Link Here
605
                    { record => $record, field => '245', subfield => 'a' }
608
                    { record => $record, field => '245', subfield => 'a' }
606
                )
609
                )
607
            ],
610
            ],
608
            ['BEGIN The art of computer programming'],
611
            ['The art of computer programming', 'BEGIN The art of computer programming'],
609
            'Update a subfield: add a string at the beginning'
612
            'Update a subfield: add a string at the beginning'
610
        );
613
        );
611
614
Lines 626-639 subtest 'copy_field' => sub { Link Here
626
                    { record => $record, field => '245', subfield => 'a' }
629
                    { record => $record, field => '245', subfield => 'a' }
627
                )
630
                )
628
            ],
631
            ],
629
            ['The art of computer programming END'],
632
            ['The art of computer programming', 'The art of computer programming END'],
630
            'Update a subfield: add a string at the end'
633
            'Update a subfield: add a string at the end'
631
        );
634
        );
632
635
636
        $record = new_record;
637
        copy_field(
638
            {
639
                record        => $record,
640
                from_field    => 245,
641
                from_subfield => 'c',
642
                to_field      => 650,
643
                to_subfield   => 'c',
644
            }
645
        );
646
647
        is_deeply(
648
            [
649
                read_field(
650
                    { record => $record, field => '650' }
651
                )
652
            ],
653
            [ 'Computer programming.', '462', 'Donald E. Knuth.' ],
654
            'Copy a subfield to an existent field but inexistent subfield'
655
        );
656
657
        $record = new_record;
658
        copy_field(
659
            {
660
                record        => $record,
661
                from_field    => 245,
662
                from_subfield => 'c',
663
                to_field      => 650,
664
                to_subfield   => '9',
665
            }
666
        );
667
668
        is_deeply(
669
            [
670
                read_field(
671
                    { record => $record, field => '650' }
672
                )
673
            ],
674
            [ 'Computer programming.', '462', 'Donald E. Knuth.' ],
675
            'Copy a subfield to an existent field / subfield'
676
        );
633
    };
677
    };
634
678
635
    subtest 'copy field' => sub {
679
    subtest 'copy field' => sub {
636
        plan tests => 12;
680
        plan tests => 14;
637
        my $record = new_record;
681
        my $record = new_record;
638
        $record->append_fields(
682
        $record->append_fields(
639
            MARC::Field->new(
683
            MARC::Field->new(
Lines 782-787 subtest 'copy_field' => sub { Link Here
782
          read_field( { record => $record, field => '999', subfield => '9' } );
826
          read_field( { record => $record, field => '999', subfield => '9' } );
783
        is_deeply( \@fields_9999, [],
827
        is_deeply( \@fields_9999, [],
784
            'copy a nonexistent field does not create a new one' );
828
            'copy a nonexistent field does not create a new one' );
829
830
        $record = new_record;
831
        copy_field(
832
            {
833
                record        => $record,
834
                from_field    => 245,
835
                to_field      => 650,
836
            }
837
        );
838
839
        is_deeply(
840
            [
841
                read_field(
842
                    { record => $record, field => '650', field_numbers => [2] }
843
                )
844
            ],
845
            [ 'The art of computer programming', 'Donald E. Knuth.' ],
846
            'Copy a field to existent fields should create a new field'
847
        );
848
        is_deeply(
849
            [
850
                read_field(
851
                    { record => $record, field => '650', field_numbers => [1] }
852
                )
853
            ],
854
            [ 'Computer programming.', '462' ],
855
            'Copy a field to existent fields should create a new field, the original one should not have been updated'
856
        );
785
    };
857
    };
786
};
858
};
787
859
788
- 

Return to bug 14098