Bug 28915: Add control field support to Koha::SimpleMARC::update_field()

Before this patch, control fields were not modifiable using this subroutine.

Control fields use character positions instead of subfields. When modifying
control fields, this patch makes the subroutine's parameter "subfield" to indicate
a character position. An example

Koha::SimpleMARC::update_field({
  record => $record,
  field  => '008',
  subfield => '2',
  values => [09],
});

changes field 008 starting from character position 2 to contain values "09".
This replaces char pos 2 with "0", and char pos 3 with "9".

To test:
1. prove t/SimpleMARC.t

Signed-off-by: David Nind <david@davidnind.com>
Signed-off-by: Andrew Fuerste Henry <andrew@bywatersolutions.com>
Signed-off-by: Anneli Österman <anneli.osterman@koha-suomi.fi>
Signed-off-by: Andrew Fuerste Henry <andrew@bywatersolutions.com>
Signed-off-by: Pedro Amorim <pedro.amorim@openfifth.co.uk>

Koha/SimpleMARC.pm

@@ -18,6 +18,8 @@ package Koha::SimpleMARC;
 use Modern::Perl;
 use base 'Exporter';
 
+use Koha::Exceptions;
+
 BEGIN {
     our @EXPORT_OK = qw(
         read_field
@@ -172,6 +174,9 @@ sub copy_and_replace_field {
 
 Missing POD for update_field.
 
+When parameter C<field> is a control field (000-009), parameter C<subfield> is
+used to indicate character position. Defaults to position C<0>.
+
 =cut
 
 sub update_field {
@@ -184,19 +189,28 @@ sub update_field {
 
     if ( !( $record && $fieldName ) ) { return; }
 
-    if ( not defined $subfieldName or $subfieldName eq '' ) {
+    if ( $fieldName > 10 && ( not defined $subfieldName or $subfieldName eq '' ) ) {
 
         # FIXME I'm not sure the actual implementation is correct.
         die "This action is not implemented yet";
 
         #_update_field({ record => $record, field => $fieldName, values => \@values });
     } else {
-        _update_subfield(
+        if ( $fieldName < 10 ) {
-            {
+            _update_controlfield(
-                record        => $record, field => $fieldName, subfield => $subfieldName, values => \@values,
+                {
-                field_numbers => $field_numbers
+                    record        => $record, field => $fieldName, position => $subfieldName, values => \@values,
-            }
+                    field_numbers => $field_numbers
-        );
+                }
+            );
+        } else {
+            _update_subfield(
+                {
+                    record        => $record, field => $fieldName, subfield => $subfieldName, values => \@values,
+                    field_numbers => $field_numbers
+                }
+            );
+        }
     }
 }
 
@@ -304,6 +318,42 @@ sub _update_subfield {
     }
 }
 
+sub _update_controlfield {
+    my ($params)  = @_;
+    my $record    = $params->{record};
+    my $fieldName = $params->{field};
+    if ( $params->{position} && $params->{position} =~ /[^0-9]/ ) {
+        Koha::Exceptions::BadParameter->throw(
+            error     => 'Parameter "subfield", if given, must be numeric',
+            parameter => 'subfield',
+        );
+    }
+    my $position      = $params->{position} ? $params->{position} + 0 : 0;    # converts 01 to 1
+    my @values        = @{ $params->{values} };
+    my $value         = $values[0];
+    my $dont_erase    = $params->{dont_erase};
+    my $field_numbers = $params->{field_numbers} // [];
+    my $i             = 0;
+
+    my $field = $record->field($fieldName);
+
+    unless ($field) {
+        ## Control field does not exist, create it.
+        $value = ' ' x $position . $value;                 # using empty whitespace ' ' as the fill character
+        $field = MARC::Field->new( $fieldName, $value );
+        $record->insert_fields_ordered($field);
+    } else {
+        unless ($dont_erase) {
+            my $controldata = $field->data;
+            if ( length($controldata) < $position ) {
+                $controldata = $controldata . ' ' x ( $position - length($controldata) );  # add leading fill characters
+            }
+            substr $controldata, $position, length($value), $value;
+            $field->update($controldata);
+        }
+    }
+}
+
 =head2 read_field
 
   my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );

t/SimpleMARC.t

@@ -2,6 +2,7 @@
 
 use Modern::Perl;
 
+use Test::Exception;
 use Test::NoWarnings;
 use Test::More tests => 13;
 
@@ -204,7 +205,7 @@ subtest 'read_field' => sub {
 
 # update_field
 subtest 'update_field' => sub {
-    plan tests => 1;
+    plan tests => 2;
     subtest 'update subfield' => sub {
         plan tests => 6;
         my $record = new_record;
@@ -304,6 +305,126 @@ subtest 'update_field' => sub {
         );
 
     };
+
+    subtest 'update control field' => sub {
+        plan tests => 11;
+        my $record = new_record;
+        update_field(
+            {
+                record   => $record,
+                field    => '008',
+                subfield => '1',
+                values   => ['1']
+            }
+        );
+        is_deeply(
+            [ read_field( { record => $record, field => '008' } ) ],
+            ['110829t20132012nyu bk 001 0ceng'],
+            'update existing subfield 008 char position 1 value from 2 to 1'
+        );
+
+        update_field(
+            {
+                record   => $record,
+                field    => '008',
+                subfield => '2',
+                values   => ['09']
+            }
+        );
+        is_deeply(
+            [ read_field( { record => $record, field => '008' } ) ],
+            ['110929t20132012nyu bk 001 0ceng'],
+            'update existing subfield 008 char positions 2-3 from 08 to 09'
+        );
+
+        update_field(
+            {
+                record   => $record,
+                field    => '008',
+                subfield => '2',
+                values   => [ '10', '08' ]
+            }
+        );
+        is_deeply(
+            [ read_field( { record => $record, field => '008' } ) ],
+            ['111029t20132012nyu bk 001 0ceng'],
+            'update existing subfield 008, only first elements from "values" is used'
+        );
+
+        is_deeply(
+            [ read_field( { record => $record, field => '007' } ) ],
+            [],
+            '007 does not yet exist'
+        );
+        update_field(
+            {
+                record   => $record,
+                field    => '007',
+                subfield => '',
+                values   => ['a']
+            }
+        );
+        is_deeply(
+            [ read_field( { record => $record, field => '007' } ) ],
+            ['a'],
+            'create non existing 007'
+        );
+
+        update_field(
+            {
+                record   => $record,
+                field    => '007',
+                subfield => '3',
+                values   => ['canzn']
+            }
+        );
+        is_deeply(
+            [ read_field( { record => $record, field => '007' } ) ],
+            ['a  canzn'],
+            'used fill characters to populate non-existing character positions, maintaining prefixed characters'
+        );
+
+        delete_field( { record => $record, field => '007' } );
+        is_deeply(
+            [ read_field( { record => $record, field => '007' } ) ],
+            [],
+            '007 does not yet exist'
+        );
+
+        update_field(
+            {
+                record   => $record,
+                field    => '007',
+                subfield => '3',
+                values   => ['canzn']
+            }
+        );
+        is_deeply(
+            [ read_field( { record => $record, field => '007' } ) ],
+            ['   canzn'],
+            'created field 007, populated non-existing prefixing character positions with fill characters'
+        );
+
+        throws_ok {
+            update_field(
+                {
+                    record   => $record,
+                    field    => '007',
+                    subfield => '3a',
+                    values   => ['canzn']
+                }
+            );
+        }
+        'Koha::Exceptions::BadParameter',
+            'Koha::Exceptions::BadParameter is thrown when non-numeric character position is given';
+
+        is( $@->parameter, 'subfield', 'Confirming the exception is due to parameter subfield' );
+        is(
+            $@->error, 'Parameter "subfield", if given, must be numeric',
+            'Confirming the exception is due to parameter subfield'
+        );
+
+    };
 };
 
 # copy_field - subfield