gitea
/
Koha-clms
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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>
This commit is contained in:
Lari Taskula 2026-04-23 10:40:24 +03:00 committed by Pedro Amorim
parent 4c255bdde8
commit 534c54f730
No known key found for this signature in database
GPG Key ID: 06B75BA7F3894D55
2 changed files with 179 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
Koha/SimpleMARC.pm
View File

@ -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(
{
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 ] ] );

123
t/SimpleMARC.t
View File

@ -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