From 112712e31cd7462533b8cb64bedfc21f04f76978 Mon Sep 17 00:00:00 2001 From: Martin Renvoize Date: Wed, 8 Jul 2026 12:25:23 +0100 Subject: [PATCH] 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 Signed-off-by: Baptiste Wojtkowski Sponsored-by: OpenFifth Signed-off-by: Nick Clemens Signed-off-by: Pedro Amorim --- Koha/Biblio/Metadata.pm | 430 ++++++++++++++++++++++++++ t/db_dependent/Koha/Biblio/Metadata.t | 283 ++++++++++++++++- 2 files changed, 708 insertions(+), 5 deletions(-) diff --git a/Koha/Biblio/Metadata.pm b/Koha/Biblio/Metadata.pm index 62639b7815..f1b394fe16 100644 --- a/Koha/Biblio/Metadata.pm +++ b/Koha/Biblio/Metadata.pm @@ -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 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, recovered via +C) + +=item * datafields with no subfields at all, which C refuses +to parse (recorded as C, 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 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 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 row for this metadata record, unless an +identical row (same C and C) 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 key looks like C or C, the C/C +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, exposed as a class method so other callers that parse MARCXML +ahead of a C save - such as C +staging records - benefit from the same repair capability instead of +re-implementing a weaker version of it. + +Returns, on success, the repaired C, 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 - human-readable field reference, e.g. C<245$a> or C<001> + +=item * C - ordinal (decimal) value of the bad character + +=item * C - 1-based character offset within the field value + +=item * C - two-line string with context window and caret pointer (see C<_context_snippet>) + +=back + +The same character class is used as L, 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{]*\btag="(\w+)"[^>]*>(.*?)}gs ) { + my ( $tag, $content ) = ( $1, $2 ); + while ( $content =~ m{]*\bcode="(\w)"[^>]*>(.*?)}gs ) { + $scan->( "$tag\$$1", $2 ); + } + } + + # Scan control fields + while ( $marcxml =~ m{]*\btag="(\w+)"[^>]*>(.*?)}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<< >> elements with no +C<< >> children at all. C 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, the datafield's tag. + +=cut + +sub _find_empty_datafields { + my ($marcxml) = @_; + + my @occurrences; + while ( $marcxml =~ m{]*)>\s*|]*)/>}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<< >> element with no C<< >> 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{]*>\s*}{}gs; + $marcxml =~ s{]*/>}{}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 diff --git a/t/db_dependent/Koha/Biblio/Metadata.t b/t/db_dependent/Koha/Biblio/Metadata.t index 711c4aab24..7a187278f2 100755 --- a/t/db_dependent/Koha/Biblio/Metadata.t +++ b/t/db_dependent/Koha/Biblio/Metadata.t @@ -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', '' );