Bug 35104: Recover MARCXML that fails to decode, or throw when unrecoverable

Koha::Biblio::Metadata->store() now validates that MARCXML round-trips
through MARC::Record before saving it, rather than saving whatever was
given and letting corruption surface later as an opaque failure
somewhere downstream.

Two faults are recovered automatically, and either or both may apply
to the same record:

- non-XML characters (recorded as nonxml_stripped, recovered via
  StripNonXmlChars)
- datafields with no subfields at all, which MARC::File::XML refuses
  to parse (recorded as empty_datafield_stripped, recovered by
  removing the empty datafield)

Each recovered fault is logged, reported via object_messages for the
caller to act on, and recorded as a biblio_metadata_errors row (tag
and subfield included where identifiable) for later review - except
where an identical row already exists for the same metadata_id, so a
source record that stays dirty across repeated saves (e.g. re-harvested
from an external repository) doesn't pile up duplicate rows for the
same fault. Existing rows are otherwise left alone on a clean save,
since they're review flags requiring explicit resolution, not a cache
to invalidate.

If the MARCXML cannot be recovered at all, Koha::Exceptions::Metadata::Invalid
is thrown. The recovery logic is exposed as a repair_marcxml class
method so other callers that parse MARCXML ahead of a store() (see
following bugs) can reuse it instead of re-implementing it.

Signed-off-by: Baptiste Bayche <baptiste.bayche@inlibro.com>
Signed-off-by: Baptiste Wojtkowski <baptiste.wojtkowski@biblibre.com>
Sponsored-by: OpenFifth
Signed-off-by: Nick Clemens <nick@bywatersolutions.com>
Signed-off-by: Pedro Amorim <pedro.amorim@openfifth.co.uk>
This commit is contained in:
Martin Renvoize 2026-07-08 12:25:23 +01:00 committed by Pedro Amorim
parent b80a26eb51
commit 112712e31c
No known key found for this signature in database
GPG Key ID: 06B75BA7F3894D55
2 changed files with 708 additions and 5 deletions

View File

@ -24,14 +24,19 @@ use C4::Biblio qw( GetMarcFromKohaField );
use C4::Charset qw( StripNonXmlChars );
use C4::Items qw( GetMarcItem );
use Koha::Biblio::Metadata::Error;
use Koha::Biblio::Metadata::Errors;
use Koha::Database;
use Koha::Exceptions::Metadata;
use Koha::Logger;
use Koha::RecordSources;
use base qw(Koha::Object);
=head1 NAME
=encoding utf-8
Koha::Metadata - Koha Metadata Object class
=head1 API
@ -40,6 +45,188 @@ Koha::Metadata - Koha Metadata Object class
=cut
=head3 store
Metadata specific store method to catch errant characters prior
to committing to the database.
If the MARCXML cannot be parsed but can be recovered, the recovered version is
saved and an error row per fault is written to C<biblio_metadata_errors> so
callers and the UI can notify the user. Two recoverable faults are currently
handled, and either or both may apply to the same record:
=over 4
=item * non-XML characters (recorded as C<nonxml_stripped>, recovered via
C<StripNonXmlChars>)
=item * datafields with no subfields at all, which C<MARC::File::XML> refuses
to parse (recorded as C<empty_datafield_stripped>, recovered by removing the
empty datafield)
=back
Any pre-existing error row is left alone when the record parses cleanly - they
are review flags requiring explicit human resolution and should not be
silently cleared by a routine re-save.
If the MARCXML cannot be recovered at all, a
I<Koha::Exceptions::Metadata::Invalid> exception is thrown.
=cut
sub store {
my $self = shift;
# Reset messages so object_messages reflects only this store call
$self->{_messages} = [];
my %recoveries; # error_type => arrayref of occurrences, for faults that were fixed
# Check marcxml will roundtrip
if ( $self->format eq 'marcxml' ) {
my $marcxml = eval {
MARC::Record::new_from_xml(
$self->metadata, 'UTF-8',
$self->schema
);
};
my $marcxml_error = $@;
chomp $marcxml_error;
unless ($marcxml) {
my ( $stripped_record, $stripped_metadata, $stripped_recoveries ) =
$self->repair_marcxml( $self->metadata, $self->schema );
if ($stripped_record) {
Koha::Logger->get->warn(
sprintf(
"Metadata for bibliographic record (biblionumber=%s) was automatically repaired before saving: %s",
$self->biblionumber // 'N/A', $marcxml_error
)
);
$self->metadata($stripped_metadata);
%recoveries = %$stripped_recoveries;
} else {
# Truly unrecoverable
Koha::Logger->get->warn($marcxml_error);
Koha::Exceptions::Metadata::Invalid->throw(
id => $self->id,
biblionumber => $self->biblionumber,
format => $self->format,
schema => $self->schema,
decoding_error => $marcxml_error,
);
}
}
}
$self->SUPER::store;
# If this save triggered a fresh repair, record each fault as a DB error row and
# signal the event via object_messages. A fault already on record for this metadata_id
# (same error_type and message) is left as-is rather than duplicated, so re-harvesting or
# re-importing a source record that is still dirty doesn't pile up repeat rows for the
# same underlying issue.
for my $error_type ( sort keys %recoveries ) {
my $occurrences = $recoveries{$error_type};
my $formatter = _error_message_formatter($error_type);
if (@$occurrences) {
for my $occ (@$occurrences) {
$self->_add_error_once( $error_type, $formatter->($occ), $occ );
}
} else {
# Fallback: couldn't pinpoint individual occurrences – store a generic message
$self->_add_error_once( $error_type, 'details unavailable' );
}
$self->add_message(
{
message => $error_type,
type => 'warning',
payload => ( join( "\n", map { $formatter->($_) } @$occurrences ) || 'details unavailable' ),
}
);
}
return $self;
}
=head3 metadata_errors
my $errors = $metadata->metadata_errors;
Returns a I<Koha::Biblio::Metadata::Errors> resultset for errors associated
with this metadata record.
=cut
sub metadata_errors {
my ($self) = @_;
return Koha::Biblio::Metadata::Errors->_new_from_dbic( scalar $self->_result->biblio_metadata_errors );
}
=head3 _add_error_once
$self->_add_error_once( $error_type, $message, $occurrence );
Records a C<biblio_metadata_errors> row for this metadata record, unless an
identical row (same C<error_type> and C<message>) already exists - so
re-triggering the same fault on a source record that stays dirty across
repeated saves doesn't pile up duplicate rows. C<$occurrence> is the optional
occurrence hashref produced by C<_find_nonxml_chars>/C<_find_empty_datafields>;
when its C<field> key looks like C<TAG$sub> or C<TAG>, the C<tag>/C<subfield>
columns are populated so callers (e.g. the cataloguing UI) don't need to parse
them back out of the free-text message.
=cut
sub _add_error_once {
my ( $self, $error_type, $message, $occurrence ) = @_;
return
if Koha::Biblio::Metadata::Errors->search(
{
metadata_id => $self->id,
error_type => $error_type,
message => $message,
}
)->count;
my ( $tag, $subfield ) =
( $occurrence && $occurrence->{field} ) ? _split_field_ref( $occurrence->{field} ) : ( undef, undef );
Koha::Biblio::Metadata::Error->new(
{
metadata_id => $self->id,
error_type => $error_type,
message => $message,
tag => $tag,
subfield => $subfield,
}
)->store;
}
=head3 _split_field_ref
my ( $tag, $subfield ) = _split_field_ref( $field_ref );
Splits a human-readable field reference such as C<245$a> into its tag and
subfield parts. Field references with no subfield (control fields, or a
datafield reported as a whole e.g. from C<_find_empty_datafields>) return an
undefined subfield.
=cut
sub _split_field_ref {
my ($field_ref) = @_;
return $field_ref =~ /^(\w+)\$(\w)$/ ? ( $1, $2 ) : ( $field_ref, undef );
}
=head3 record
my $record = $metadata->record;
@ -255,6 +442,249 @@ sub _embed_items {
return $record;
}
=head3 _context_snippet
my $snippet = _context_snippet( \@chars, $pos_0, $char_ord );
Given an array-ref of characters C<\@chars>, a 0-based position C<$pos_0> of
a bad character, and its ordinal C<$char_ord>, returns a two-line string:
=over 4
=item * Line 1 – up to 30 characters of context either side of the bad
character, with the bad character replaced by a visible glyph (Unicode
Control Pictures U+2400–U+241F for C0 controls, C<␡> for DEL, C<?>
otherwise) and ellipses when the window is truncated.
=item * Line 2 – a caret (C<^>) aligned beneath the visible glyph.
=back
Example output (4-space indent):
t $xtac arr␈\ $btxt V $2rdacontent
^
=cut
sub _context_snippet {
my ( $chars_ref, $pos_0, $char_ord ) = @_;
# Visible stand-in for the removed character:
# C0 controls (U+0000–U+001F) → Unicode Control Pictures (U+2400–U+241F)
# DEL (U+007F) → U+2421 SYMBOL FOR DELETE (␡)
# anything else → U+FFFD REPLACEMENT CHARACTER (?)
my $visible =
$char_ord <= 0x1F ? chr( $char_ord + 0x2400 )
: $char_ord == 0x7F ? "\x{2421}"
: "\x{FFFD}";
my $last = $#{$chars_ref};
my $win = 30;
my $pre_start = ( $pos_0 > $win ) ? $pos_0 - $win : 0;
my $post_end = ( $pos_0 + $win < $last ) ? $pos_0 + $win : $last;
my $pre = $pos_0 > 0 ? join( '', @{$chars_ref}[ $pre_start .. $pos_0 - 1 ] ) : '';
my $post = $pos_0 < $last ? join( '', @{$chars_ref}[ $pos_0 + 1 .. $post_end ] ) : '';
my $prefix = ( $pos_0 > $win ) ? '...' : '';
my $suffix = ( $pos_0 + $win < $last ) ? '...' : '';
my $indent = ' ';
my $line = "$indent$prefix$pre$visible$post$suffix";
my $caret_col = length($indent) + length($prefix) + length($pre);
return "$line\n" . ( ' ' x $caret_col ) . '^';
}
=head3 repair_marcxml
my ( $record, $repaired_xml, $recoveries ) =
Koha::Biblio::Metadata->repair_marcxml( $marcxml, $marc_schema );
Attempts to repair a MARCXML string that fails to parse, by stripping
whichever of the known-recoverable faults (non-XML characters,
subfield-less datafields) are present. This is the same recovery logic used
by C<store>, exposed as a class method so other callers that parse MARCXML
ahead of a C<Koha::Biblio::Metadata> save - such as C<Koha::Import::Record>
staging records - benefit from the same repair capability instead of
re-implementing a weaker version of it.
Returns, on success, the repaired C<MARC::Record>, the repaired XML string,
and a hashref of C<< error_type => \@occurrences >> (see
C<_find_nonxml_chars>/C<_find_empty_datafields>) describing what was fixed.
Returns an empty list if the XML has none of the known-recoverable faults,
or if it still doesn't parse once they're stripped.
=cut
sub repair_marcxml {
my ( $class, $marcxml, $marc_schema ) = @_;
my @nonxml_chars = _find_nonxml_chars($marcxml);
my @empty_datafields = _find_empty_datafields($marcxml);
return unless @nonxml_chars || @empty_datafields;
my $stripped_metadata = $marcxml;
$stripped_metadata = StripNonXmlChars($stripped_metadata) if @nonxml_chars;
$stripped_metadata = _strip_empty_datafields($stripped_metadata) if @empty_datafields;
my $stripped_record = eval { MARC::Record::new_from_xml( $stripped_metadata, 'UTF-8', $marc_schema ); };
return unless $stripped_record;
my %recoveries;
$recoveries{ Koha::Biblio::Metadata::Error::NONXML_STRIPPED() } = \@nonxml_chars if @nonxml_chars;
$recoveries{ Koha::Biblio::Metadata::Error::EMPTY_DATAFIELD_STRIPPED() } = \@empty_datafields if @empty_datafields;
return ( $stripped_record, $stripped_metadata, \%recoveries );
}
=head3 _find_nonxml_chars
my @occurrences = _find_nonxml_chars( $marcxml_string );
Scans a raw MARC XML string for every individual character that is illegal
in XML 1.0. Returns a list of hashrefs (one per character occurrence) with
the following keys:
=over 4
=item * C<field> - human-readable field reference, e.g. C<245$a> or C<001>
=item * C<char_ord> - ordinal (decimal) value of the bad character
=item * C<position> - 1-based character offset within the field value
=item * C<snippet> - two-line string with context window and caret pointer (see C<_context_snippet>)
=back
The same character class is used as L<C4::Charset/StripNonXmlChars>, so
every occurrence returned here is exactly one that would be stripped.
=cut
sub _find_nonxml_chars {
my ($marcxml) = @_;
# Characters illegal in XML 1.0 – identical to the set stripped by StripNonXmlChars
my $non_xml_re = qr/[^\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]/;
my @occurrences;
my $scan = sub {
my ( $field_ref, $val ) = @_;
my @chars = split //, $val;
for my $i ( 0 .. $#chars ) {
if ( $chars[$i] =~ $non_xml_re ) {
push @occurrences, {
field => $field_ref,
char_ord => ord( $chars[$i] ),
position => $i + 1,
snippet => _context_snippet( \@chars, $i, ord( $chars[$i] ) ),
};
}
}
};
# Scan every subfield inside every datafield
while ( $marcxml =~ m{<datafield\b[^>]*\btag="(\w+)"[^>]*>(.*?)</datafield>}gs ) {
my ( $tag, $content ) = ( $1, $2 );
while ( $content =~ m{<subfield\b[^>]*\bcode="(\w)"[^>]*>(.*?)</subfield>}gs ) {
$scan->( "$tag\$$1", $2 );
}
}
# Scan control fields
while ( $marcxml =~ m{<controlfield\b[^>]*\btag="(\w+)"[^>]*>(.*?)</controlfield>}gs ) {
$scan->( $1, $2 );
}
return @occurrences;
}
=head3 _find_empty_datafields
my @occurrences = _find_empty_datafields( $marcxml_string );
Scans a raw MARC XML string for C<< <datafield> >> elements with no
C<< <subfield> >> children at all. C<MARC::File::XML> refuses to parse such
a field (it dies with "Field NNN must have at least one subfield"), which
happens with legacy data saved before this validation existed.
Returns a list of hashrefs (one per occurrence) with the single key
C<field>, the datafield's tag.
=cut
sub _find_empty_datafields {
my ($marcxml) = @_;
my @occurrences;
while ( $marcxml =~ m{<datafield\b([^>]*)>\s*</datafield>|<datafield\b([^>]*)/>}gs ) {
my $attrs = defined $1 ? $1 : $2;
my ($tag) = $attrs =~ /\btag="(\w+)"/;
push @occurrences, { field => $tag // 'unknown' };
}
return @occurrences;
}
=head3 _strip_empty_datafields
my $cleaned_marcxml = _strip_empty_datafields( $marcxml_string );
Removes every C<< <datafield> >> element with no C<< <subfield> >> children
from a raw MARC XML string, so the record can be parsed and saved. The
removed field's data cannot be recovered - callers should record an error
row (see C<_find_empty_datafields>) so a cataloguer can review and re-add it.
=cut
sub _strip_empty_datafields {
my ($marcxml) = @_;
return $marcxml unless defined $marcxml;
$marcxml =~ s{<datafield\b[^>]*>\s*</datafield>}{}gs;
$marcxml =~ s{<datafield\b[^>]*/>}{}gs;
return $marcxml;
}
=head3 _error_message_formatter
my $formatter = _error_message_formatter( $error_type );
my $message = $formatter->( $occurrence );
Returns a coderef that turns one occurrence hashref (as produced by
C<_find_nonxml_chars> or C<_find_empty_datafields>) into a human-readable
message line for the given C<$error_type>.
=cut
sub _error_message_formatter {
my ($error_type) = @_;
return sub {
my ($occ) = @_;
return sprintf(
"%s: invalid char value %d (U+%04X) at position %d\n%s",
$occ->{field}, $occ->{char_ord}, $occ->{char_ord}, $occ->{position}, $occ->{snippet}
);
}
if $error_type eq Koha::Biblio::Metadata::Error::NONXML_STRIPPED;
return sub {
my ($occ) = @_;
return sprintf( "%s: field removed, it had no subfields", $occ->{field} );
}
if $error_type eq Koha::Biblio::Metadata::Error::EMPTY_DATAFIELD_STRIPPED;
return sub { 'details unavailable' };
}
=head3 _type
=cut

View File

@ -18,7 +18,7 @@
use Modern::Perl;
use Test::NoWarnings;
use Test::More tests => 6;
use Test::More tests => 7;
use Test::Exception;
use Test::MockModule;
use Test::Warn;
@ -28,6 +28,8 @@ use t::lib::Mocks;
use C4::Biblio qw( AddBiblio );
use Koha::Database;
use MARC::Record;
use MARC::Field;
BEGIN {
use_ok('Koha::Biblio::Metadatas');
@ -36,6 +38,269 @@ BEGIN {
my $schema = Koha::Database->new->schema;
my $builder = t::lib::TestBuilder->new;
subtest 'Testing store() method' => sub {
plan tests => 8;
$schema->storage->txn_begin;
# Create a test bibliographic record
my $biblio = $builder->build(
{
source => 'Biblio',
}
);
subtest 'Valid MARCXML storage' => sub {
plan tests => 2;
$schema->storage->txn_begin;
my $marc_rec = MARC::Record->new;
$marc_rec->append_fields( MARC::Field->new( '245', '', '', 'a' => 'Test Title' ) );
my $valid_marcxml = $marc_rec->as_xml_record('MARC21');
my $record = Koha::Biblio::Metadata->new(
{
format => 'marcxml',
metadata => $valid_marcxml,
biblionumber => $biblio->{biblionumber},
schema => 'MARC21',
}
);
lives_ok { $record->store }
'Valid MARCXML record stores successfully';
is(
$record->metadata_errors->search( { error_type => 'nonxml_stripped' } )->count,
0, 'No nonxml_stripped error for clean record'
);
$schema->storage->txn_rollback;
};
subtest 'MARCXML with strippable non-XML characters' => sub {
plan tests => 4;
$schema->storage->txn_begin;
# Build MARCXML containing a non-XML control character (chr(31) = Unit Separator)
my $bad_title = 'Title with' . chr(31) . ' bad character';
my $clean_title = 'Title with bad character';
# Generate the MARCXML string with the embedded bad character
my $marc_record = MARC::Record->new;
$marc_record->append_fields( MARC::Field->new( '245', '', '', 'a' => $bad_title ) );
my $marcxml_with_bad_char = $marc_record->as_xml_record('MARC21');
my $record = Koha::Biblio::Metadata->new(
{
format => 'marcxml',
metadata => $marcxml_with_bad_char,
biblionumber => $biblio->{biblionumber},
schema => 'MARC21',
}
);
lives_ok { $record->store } 'MARCXML with strippable characters stores successfully';
my @errors = $record->metadata_errors->search( { error_type => 'nonxml_stripped' } )->as_list;
ok( scalar @errors, 'nonxml_stripped error(s) recorded after stripping' );
like(
$errors[0]->message,
qr/245\$a: invalid char value 31 \(U\+001F\) at position \d+/,
'error message identifies field, char value, and position'
);
my $stored = Koha::Biblio::Metadatas->find( { biblionumber => $biblio->{biblionumber}, format => 'marcxml' } );
is(
$stored->record->field('245')->subfield('a'),
$clean_title,
'Stored record has control character removed'
);
$schema->storage->txn_rollback;
};
subtest 'MARCXML with an empty datafield' => sub {
plan tests => 4;
$schema->storage->txn_begin;
# A datafield with no subfields at all cannot be produced via the public MARC::Field
# API (it refuses to construct one), but legacy data saved before this validation
# existed can contain exactly that. Simulate it by poking the internal structure.
my $marc_record = MARC::Record->new;
$marc_record->append_fields( MARC::Field->new( '245', '', '', 'a' => 'Test Title' ) );
my $empty_field = MARC::Field->new( '500', ' ', ' ', 'a' => 'placeholder' );
$empty_field->{_subfields} = [];
$marc_record->append_fields($empty_field);
my $marcxml_with_empty_field = $marc_record->as_xml_record('MARC21');
my $record = Koha::Biblio::Metadata->new(
{
format => 'marcxml',
metadata => $marcxml_with_empty_field,
biblionumber => $biblio->{biblionumber},
schema => 'MARC21',
}
);
lives_ok { $record->store } 'MARCXML with an empty datafield stores successfully';
my @errors = $record->metadata_errors->search( { error_type => 'empty_datafield_stripped' } )->as_list;
ok( scalar @errors, 'empty_datafield_stripped error(s) recorded after stripping' );
like(
$errors[0]->message,
qr/^500: field removed, it had no subfields/,
'error message identifies the removed field'
);
my $stored = Koha::Biblio::Metadatas->find( { biblionumber => $biblio->{biblionumber}, format => 'marcxml' } );
ok( !$stored->record->field('500'), 'Stored record no longer has the empty field' );
$schema->storage->txn_rollback;
};
subtest 'MARCXML with both strippable characters and an empty datafield' => sub {
plan tests => 3;
$schema->storage->txn_begin;
my $marc_record = MARC::Record->new;
$marc_record->append_fields( MARC::Field->new( '245', '', '', 'a' => 'Bad' . chr(31) . ' Title' ) );
my $empty_field = MARC::Field->new( '500', ' ', ' ', 'a' => 'placeholder' );
$empty_field->{_subfields} = [];
$marc_record->append_fields($empty_field);
my $marcxml = $marc_record->as_xml_record('MARC21');
my $record = Koha::Biblio::Metadata->new(
{
format => 'marcxml',
metadata => $marcxml,
biblionumber => $biblio->{biblionumber},
schema => 'MARC21',
}
);
lives_ok { $record->store } 'MARCXML with both faults stores successfully';
ok(
$record->metadata_errors->search( { error_type => 'nonxml_stripped' } )->count,
'nonxml_stripped error recorded'
);
ok(
$record->metadata_errors->search( { error_type => 'empty_datafield_stripped' } )->count,
'empty_datafield_stripped error recorded'
);
$schema->storage->txn_rollback;
};
subtest 'Non-MARCXML format' => sub {
plan tests => 1;
$schema->storage->txn_begin;
my $other_metadata = '{"title": "Test Title"}';
my $record = Koha::Biblio::Metadata->new(
{
format => 'json',
metadata => $other_metadata,
biblionumber => $biblio->{biblionumber},
schema => 'LOCAL',
}
);
lives_ok { $record->store }
'Non-MARCXML record stores without validation';
$schema->storage->txn_rollback;
};
subtest 'Empty MARCXML handling' => sub {
plan tests => 1;
$schema->storage->txn_begin;
my $empty_record = Koha::Biblio::Metadata->new(
{
format => 'marcxml',
metadata => '',
biblionumber => $biblio->{biblionumber},
schema => 'MARC21',
}
);
throws_ok { $empty_record->store }
'Koha::Exceptions::Metadata::Invalid',
'Empty MARCXML throws expected exception';
$schema->storage->txn_rollback;
};
subtest 'Re-saving a record with the same recoverable fault does not duplicate the error row' => sub {
plan tests => 2;
$schema->storage->txn_begin;
my $bad_title = 'Title with' . chr(31) . ' bad character';
my $marc_record = MARC::Record->new;
$marc_record->append_fields( MARC::Field->new( '245', '', '', 'a' => $bad_title ) );
my $marcxml_with_bad_char = $marc_record->as_xml_record('MARC21');
my $record = Koha::Biblio::Metadata->new(
{
format => 'marcxml',
metadata => $marcxml_with_bad_char,
biblionumber => $biblio->{biblionumber},
schema => 'MARC21',
}
);
$record->store;
# Simulate the same dirty source record being re-harvested/re-imported again
# before anyone fixes the underlying data.
$record->metadata($marcxml_with_bad_char);
$record->store;
is(
$record->metadata_errors->search( { error_type => 'nonxml_stripped' } )->count,
1, 'Re-triggering the exact same fault does not create a duplicate error row'
);
is(
Koha::Biblio::Metadatas->find( { biblionumber => $biblio->{biblionumber}, format => 'marcxml' } )
->record->subfield( '245', 'a' ),
'Title with bad character',
'The record is still stored with the control character removed'
);
$schema->storage->txn_rollback;
};
subtest 'Pre-existing error rows survive a clean re-save' => sub {
plan tests => 1;
$schema->storage->txn_begin;
my $bad_title = 'Title with' . chr(31) . ' bad character';
my $marc_record = MARC::Record->new;
$marc_record->append_fields( MARC::Field->new( '245', '', '', 'a' => $bad_title ) );
my $record = Koha::Biblio::Metadata->new(
{
format => 'marcxml',
metadata => $marc_record->as_xml_record('MARC21'),
biblionumber => $biblio->{biblionumber},
schema => 'MARC21',
}
);
$record->store; # records the nonxml_stripped error row
# Re-save with already-clean MARCXML, as if the cataloguer just edited an unrelated
# field - the earlier fault has not been explicitly resolved.
my $clean_record = MARC::Record->new;
$clean_record->append_fields( MARC::Field->new( '245', '', '', 'a' => 'Title with bad character' ) );
$record->metadata( $clean_record->as_xml_record('MARC21') );
$record->store;
is(
$record->metadata_errors->search( { error_type => 'nonxml_stripped' } )->count,
1,
'The pre-existing error row is left in place after a subsequent clean save, since resolution is explicit'
);
$schema->storage->txn_rollback;
};
};
subtest 'record() tests' => sub {
plan tests => 11;
@ -124,7 +389,7 @@ subtest 'record_strip_nonxml() tests' => sub {
$schema->storage->txn_begin;
my $title = 'Oranges and' . chr(31) . ' Peaches';
my $title = 'Oranges and Peaches';
# Create a valid record
my $record = MARC::Record->new();
@ -133,7 +398,16 @@ subtest 'record_strip_nonxml() tests' => sub {
my ($biblio_id) = C4::Biblio::AddBiblio( $record, '' );
my $metadata = Koha::Biblios->find($biblio_id)->metadata;
my $record2 = $metadata->record_strip_nonxml;
# Update the record in the database directly to include our error character
my $bad_title = 'Oranges and' . chr(31) . ' Peaches';
$record = $metadata->record;
$record->delete_fields( $record->field('245') );
$record->insert_fields_ordered( MARC::Field->new( '245', '', '', 'a' => $bad_title ) );
$metadata->_result->update( { metadata => $record->as_xml_record } );
$metadata->discard_changes;
my $record2 = $metadata->record_strip_nonxml;
is( ref $record2, 'MARC::Record', 'Method record() returned a MARC::Record object' );
is(
@ -157,8 +431,7 @@ subtest 'record_strip_nonxml() tests' => sub {
"record_strip_nonxml returns undef when the record cannot be parsed after removing nonxml characters"
);
my $builder = t::lib::TestBuilder->new;
my $item = $builder->build_sample_item( { biblionumber => $metadata->biblionumber } );
my $item = $builder->build_sample_item( { biblionumber => $metadata->biblionumber } );
# Emptied the OpacHiddenItems pref
t::lib::Mocks::mock_preference( 'OpacHiddenItems', '' );