Bug 14098: FIX Copy a subfield should not update the original field

There is an inconsistency in the copy action:

Given the following control sample:

  245    _aThe art of computer programming
         _cDonald E. Knuth.
  300    _aA_exists
         _bB_exists

If we apply action (a) Copy the whole field 245 to 300, we get:

  245    _aThe art of computer programming
         _cDonald E. Knuth.
  300    _aA_exists
         _bB_exists
  300    _aThe art of computer programming
         _cDonald E. Knuth.

If we apply action (b) Copy the subfield 245$a to 300$a, we get:

  245    _aThe art of computer programming
         _cDonald E. Knuth.
  300    _aThe art of computer programming
         _bB_exists

In (a) the field is copied but in (b) the subfield is erased.

We should be consistent and don't erase the destination field.

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>

diff --git a/Koha/SimpleMARC.pm b/Koha/SimpleMARC.pm
index 3d99dec..991d8a9 100644 (file)
--- a/Koha/SimpleMARC.pm
+++ b/Koha/SimpleMARC.pm
@@ -123,6 +123,7 @@ sub _copy_field {
         to_field => $toFieldName,
         regex => $regex,
         field_numbers => $field_numbers,
+        action => 'copy',
     });
 }
 
@@ -136,13 +137,16 @@ sub _copy_subfield {
     my $regex = $params->{regex};
     my $field_numbers = $params->{field_numbers} // [];
 
-    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
-    if ( @$field_numbers ) {
-        @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
-    }
-    _modify_values({ values => \@values, regex => $regex });
-
-    update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values });
+    _copy_move_subfield({
+        record => $record,
+        from_field => $fromFieldName,
+        from_subfield => $fromSubfieldName,
+        to_field => $toFieldName,
+        to_subfield => $toSubfieldName,
+        regex => $regex,
+        field_numbers => $field_numbers,
+        action => 'copy',
+    });
 }
 
 sub update_field {
@@ -463,20 +467,15 @@ sub _move_subfield {
     my $regex = $params->{regex};
     my $field_numbers = $params->{field_numbers} // [];
 
-    # Copy
-    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
-    if ( @$field_numbers ) {
-        @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
-    }
-    _modify_values({ values => \@values, regex => $regex });
-    _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => 1, values => \@values });
-
-    # And delete
-    _delete_subfield({
+    _copy_move_subfield({
         record => $record,
-        field => $fromFieldName,
-        subfield => $fromSubfieldName,
+        from_field => $fromFieldName,
+        from_subfield => $fromSubfieldName,
+        to_field => $toFieldName,
+        to_subfield => $toSubfieldName,
+        regex => $regex,
         field_numbers => $field_numbers,
+        action => 'move',
     });
 }
 
@@ -570,6 +569,36 @@ sub _copy_move_field {
     }
 }
 
+sub _copy_move_subfield {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fromFieldName = $params->{from_field};
+    my $fromSubfieldName = $params->{from_subfield};
+    my $toFieldName = $params->{to_field};
+    my $toSubfieldName = $params->{to_subfield};
+    my $regex = $params->{regex};
+    my $field_numbers = $params->{field_numbers} // [];
+    my $action = $params->{action} || 'copy';
+
+    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
+    if ( @$field_numbers ) {
+        @values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
+    }
+    _modify_values({ values => \@values, regex => $regex });
+    my $dont_erase = $action eq 'copy' ? 1 : 0;
+    _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values, dont_erase => $dont_erase });
+
+    # And delete if it's a move
+    if ( $action eq 'move' ) {
+        _delete_subfield({
+            record => $record,
+            field => $fromFieldName,
+            subfield => $fromSubfieldName,
+            field_numbers => $field_numbers,
+        });
+    }
+}
+
 sub _modify_values {
     my ( $params ) = @_;
     my $values = $params->{values};

diff --git a/t/SimpleMARC.t b/t/SimpleMARC.t
index 6b2a316..880653b 100644 (file)
--- a/t/SimpleMARC.t
+++ b/t/SimpleMARC.t
@@ -287,7 +287,7 @@ subtest 'update_field' => sub {
 subtest 'copy_field' => sub {
     plan tests              => 2;
     subtest 'copy subfield' => sub {
-        plan tests => 18;
+        plan tests => 20;
         my $record = new_record;
         $record->append_fields(
             MARC::Field->new(
@@ -387,7 +387,7 @@ subtest 'copy_field' => sub {
                     { record => $record, field => '651', subfield => 'a' }
                 )
             ],
-            ['Computer algorithms.'],
+            ['Computer programming.', 'Computer algorithms.'],
             'Copy second field 650$a'
         );
         delete_field( { record => $record, field => '651' } );
@@ -409,6 +409,7 @@ subtest 'copy_field' => sub {
             [ 'The art of programming.', 'The art of algorithms.' ],
             'Copy field using regex'
         );
+        delete_field( { record => $record, field => '651' } );
 
         copy_field(
             {
@@ -549,6 +550,7 @@ subtest 'copy_field' => sub {
             'Copy field using regex'
         );
 
+        $record = new_record;
         $record->append_fields(
             MARC::Field->new(
                 952, ' ', ' ',
@@ -568,9 +570,10 @@ subtest 'copy_field' => sub {
         );
         my @fields_952d =
           read_field( { record => $record, field => '952', subfield => 'd' } );
+        # FIXME We need a new action "duplicate" if we don't want to modify the original field
         is_deeply(
             \@fields_952d,
-            [ '2001-06-25', '2001-06-25' ],
+            [ '2001-06-25', '2001-06-25', '2001-06-25' ],
             'copy 952$d into others 952 field'
         );
 
@@ -605,7 +608,7 @@ subtest 'copy_field' => sub {
                     { record => $record, field => '245', subfield => 'a' }
                 )
             ],
-            ['BEGIN The art of computer programming'],
+            ['The art of computer programming', 'BEGIN The art of computer programming'],
             'Update a subfield: add a string at the beginning'
         );
 
@@ -626,14 +629,55 @@ subtest 'copy_field' => sub {
                     { record => $record, field => '245', subfield => 'a' }
                 )
             ],
-            ['The art of computer programming END'],
+            ['The art of computer programming', 'The art of computer programming END'],
             'Update a subfield: add a string at the end'
         );
 
+        $record = new_record;
+        copy_field(
+            {
+                record        => $record,
+                from_field    => 245,
+                from_subfield => 'c',
+                to_field      => 650,
+                to_subfield   => 'c',
+            }
+        );
+
+        is_deeply(
+            [
+                read_field(
+                    { record => $record, field => '650' }
+                )
+            ],
+            [ 'Computer programming.', '462', 'Donald E. Knuth.' ],
+            'Copy a subfield to an existent field but inexistent subfield'
+        );
+
+        $record = new_record;
+        copy_field(
+            {
+                record        => $record,
+                from_field    => 245,
+                from_subfield => 'c',
+                to_field      => 650,
+                to_subfield   => '9',
+            }
+        );
+
+        is_deeply(
+            [
+                read_field(
+                    { record => $record, field => '650' }
+                )
+            ],
+            [ 'Computer programming.', '462', 'Donald E. Knuth.' ],
+            'Copy a subfield to an existent field / subfield'
+        );
     };
 
     subtest 'copy field' => sub {
-        plan tests => 12;
+        plan tests => 14;
         my $record = new_record;
         $record->append_fields(
             MARC::Field->new(
@@ -782,6 +826,34 @@ subtest 'copy_field' => sub {
           read_field( { record => $record, field => '999', subfield => '9' } );
         is_deeply( \@fields_9999, [],
             'copy a nonexistent field does not create a new one' );
+
+        $record = new_record;
+        copy_field(
+            {
+                record        => $record,
+                from_field    => 245,
+                to_field      => 650,
+            }
+        );
+
+        is_deeply(
+            [
+                read_field(
+                    { record => $record, field => '650', field_numbers => [2] }
+                )
+            ],
+            [ 'The art of computer programming', 'Donald E. Knuth.' ],
+            'Copy a field to existent fields should create a new field'
+        );
+        is_deeply(
+            [
+                read_field(
+                    { record => $record, field => '650', field_numbers => [1] }
+                )
+            ],
+            [ 'Computer programming.', '462' ],
+            'Copy a field to existent fields should create a new field, the original one should not have been updated'
+        );
     };
 };