From 534c54f7306004e1a86945f67b4183f5eca458b5 Mon Sep 17 00:00:00 2001 From: Lari Taskula Date: Thu, 23 Apr 2026 10:40:24 +0300 Subject: [PATCH] Bug 28915: Add control field support to Koha::SimpleMARC::update_field() MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 Signed-off-by: Andrew Fuerste Henry Signed-off-by: Anneli Österman Signed-off-by: Andrew Fuerste Henry Signed-off-by: Pedro Amorim --- Koha/SimpleMARC.pm | 64 ++++++++++++++++++++--- t/SimpleMARC.t | 123 ++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 179 insertions(+), 8 deletions(-) diff --git a/Koha/SimpleMARC.pm b/Koha/SimpleMARC.pm index e7406c8f5e..672b975a54 100644 --- a/Koha/SimpleMARC.pm +++ b/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 is a control field (000-009), parameter C 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( - { - record => $record, field => $fieldName, subfield => $subfieldName, values => \@values, - field_numbers => $field_numbers - } - ); + if ( $fieldName < 10 ) { + _update_controlfield( + { + 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 ] ] ); diff --git a/t/SimpleMARC.t b/t/SimpleMARC.t index 9c8c1dbba5..56dd7a77d7 100755 --- a/t/SimpleMARC.t +++ b/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