|
Lines 132-139
sub store {
Link Here
|
| 132 |
metadata_id => $self->id, |
132 |
metadata_id => $self->id, |
| 133 |
error_type => 'nonxml_stripped', |
133 |
error_type => 'nonxml_stripped', |
| 134 |
message => sprintf( |
134 |
message => sprintf( |
| 135 |
"%s: invalid char value %d (U+%04X) at position %d", |
135 |
"%s: invalid char value %d (U+%04X) at position %d\n%s", |
| 136 |
$occ->{field}, $occ->{char_ord}, $occ->{char_ord}, $occ->{position} |
136 |
$occ->{field}, $occ->{char_ord}, $occ->{char_ord}, $occ->{position}, |
|
|
137 |
$occ->{snippet} |
| 137 |
), |
138 |
), |
| 138 |
} |
139 |
} |
| 139 |
)->store; |
140 |
)->store; |
|
Lines 383-388
sub _embed_items {
Link Here
|
| 383 |
return $record; |
384 |
return $record; |
| 384 |
} |
385 |
} |
| 385 |
|
386 |
|
|
|
387 |
=head3 _context_snippet |
| 388 |
|
| 389 |
my $snippet = _context_snippet( \@chars, $pos_0, $char_ord ); |
| 390 |
|
| 391 |
Given an array-ref of characters C<\@chars>, a 0-based position C<$pos_0> of |
| 392 |
a bad character, and its ordinal C<$char_ord>, returns a two-line string: |
| 393 |
|
| 394 |
=over 4 |
| 395 |
|
| 396 |
=item * Line 1 – up to 30 characters of context either side of the bad |
| 397 |
character, with the bad character replaced by a C<[U+XXXX]> marker and |
| 398 |
ellipses when the window is truncated. |
| 399 |
|
| 400 |
=item * Line 2 – a caret (C<^>) aligned beneath the start of the marker. |
| 401 |
|
| 402 |
=back |
| 403 |
|
| 404 |
Example output (4-space indent): |
| 405 |
|
| 406 |
...arr \ [U+0008]$btxt V $2rdac ontent |
| 407 |
^ |
| 408 |
|
| 409 |
=cut |
| 410 |
|
| 411 |
sub _context_snippet { |
| 412 |
my ( $chars_ref, $pos_0, $char_ord ) = @_; |
| 413 |
|
| 414 |
my $marker = sprintf '[U+%04X]', $char_ord; |
| 415 |
my $last = $#{$chars_ref}; |
| 416 |
my $win = 30; |
| 417 |
|
| 418 |
my $pre_start = ( $pos_0 > $win ) ? $pos_0 - $win : 0; |
| 419 |
my $post_end = ( $pos_0 + $win < $last ) ? $pos_0 + $win : $last; |
| 420 |
|
| 421 |
my $pre = $pos_0 > 0 ? join( '', @{$chars_ref}[ $pre_start .. $pos_0 - 1 ] ) : ''; |
| 422 |
my $post = $pos_0 < $last ? join( '', @{$chars_ref}[ $pos_0 + 1 .. $post_end ] ) : ''; |
| 423 |
|
| 424 |
my $prefix = ( $pos_0 > $win ) ? '...' : ''; |
| 425 |
my $suffix = ( $pos_0 + $win < $last ) ? '...' : ''; |
| 426 |
|
| 427 |
my $indent = ' '; |
| 428 |
my $line = "$indent$prefix$pre$marker$post$suffix"; |
| 429 |
my $caret_col = length($indent) + length($prefix) + length($pre); |
| 430 |
|
| 431 |
return "$line\n" . ( ' ' x $caret_col ) . '^'; |
| 432 |
} |
| 433 |
|
| 386 |
=head3 _find_nonxml_chars |
434 |
=head3 _find_nonxml_chars |
| 387 |
|
435 |
|
| 388 |
my @occurrences = _find_nonxml_chars( $marcxml_string ); |
436 |
my @occurrences = _find_nonxml_chars( $marcxml_string ); |
|
Lines 399-404
the following keys:
Link Here
|
| 399 |
|
447 |
|
| 400 |
=item * C<position> - 1-based character offset within the field value |
448 |
=item * C<position> - 1-based character offset within the field value |
| 401 |
|
449 |
|
|
|
450 |
=item * C<snippet> - two-line string with context window and caret pointer (see C<_context_snippet>) |
| 451 |
|
| 402 |
=back |
452 |
=back |
| 403 |
|
453 |
|
| 404 |
The same character class is used as L<C4::Charset/StripNonXmlChars>, so |
454 |
The same character class is used as L<C4::Charset/StripNonXmlChars>, so |
|
Lines 416-432
sub _find_nonxml_chars {
Link Here
|
| 416 |
|
466 |
|
| 417 |
my $scan = sub { |
467 |
my $scan = sub { |
| 418 |
my ( $field_ref, $val ) = @_; |
468 |
my ( $field_ref, $val ) = @_; |
| 419 |
my $pos = 1; |
469 |
my @chars = split //, $val; |
| 420 |
for my $char ( split //, $val ) { |
470 |
for my $i ( 0 .. $#chars ) { |
| 421 |
if ( $char =~ $non_xml_re ) { |
471 |
if ( $chars[$i] =~ $non_xml_re ) { |
| 422 |
push @occurrences, |
472 |
push @occurrences, { |
| 423 |
{ |
|
|
| 424 |
field => $field_ref, |
473 |
field => $field_ref, |
| 425 |
char_ord => ord($char), |
474 |
char_ord => ord( $chars[$i] ), |
| 426 |
position => $pos, |
475 |
position => $i + 1, |
| 427 |
}; |
476 |
snippet => _context_snippet( \@chars, $i, ord( $chars[$i] ) ), |
|
|
477 |
}; |
| 428 |
} |
478 |
} |
| 429 |
$pos++; |
|
|
| 430 |
} |
479 |
} |
| 431 |
}; |
480 |
}; |
| 432 |
|
481 |
|
| 433 |
- |
|
|