Próba ulepszenia komunikatu ostrzegawczego kodu dekodującego :: Segfault w usłudze $ SIG {__ WARN__}

Question

Próbuję poprawić komunikat ostrzegawczy wydany przez Encode::decode(). Zamiast drukować nazwę modułu i numer linii w module, chciałbym, aby wydrukował nazwę odczytanego pliku i numer linii w tym pliku, w którym znaleziono zniekształcone dane. Dla programisty wiadomość początkowa może być przydatna, ale dla użytkownika końcowego, który nie zna Perla, prawdopodobnie nie ma ona żadnego znaczenia. Użytkownik końcowy raczej chciałby wiedzieć, który plik daje problem.

Najpierw próbowałem rozwiązać ten problem, używając do tego obsługi $SIG{__WARN__} (co prawdopodobnie nie jest dobrym pomysłem), ale otrzymuję błąd segfault. Prawdopodobnie głupi błąd, ale nie mogłem zrozumieć to:

#! /usr/bin/env perl 

use feature qw(say); 
use strict; 
use warnings; 

use Encode(); 

binmode STDOUT, ':utf8'; 
binmode STDERR, ':utf8'; 

my $fn = 'test.txt'; 
write_test_file($fn); 

# Try to improve the Encode::FB_WARN fallback warning message : 
# 
# utf8 "\xE5" does not map to Unicode at <module_name> line xx 
# 
# Rather we would like the warning to print the filename and the line number: 
# 
# utf8 "\xE5" does not map to Unicode at line xx of file <filename>. 

my $str = ''; 
open (my $fh, "<:encoding(utf-8)", $fn) or die "Could not open file '$fn': $!"; 
{ 
    local $SIG{__WARN__} = sub { my_warn_handler($fn, $_[0]) }; 
    $str = do { local $/; <$fh> }; 
} 
close $fh; 
say "Read string: '$str'"; 

sub my_warn_handler { 
    my ($fn, $msg) = @_; 

    if ($msg =~ /\Qdoes not map to Unicode\E/) { 
     recover_line_number_and_char_pos($fn, $msg); 
    } 
    else { 
     warn $msg; 
    } 
} 

sub recover_line_number_and_char_pos { 
    my ($fn, $err_msg) = @_; 

    chomp $err_msg; 
    $err_msg =~ s/(line \d+)\.$/$1/; # Remove period at end of sentence. 
    open ($fh, "<:raw", $fn) or die "Could not open file '$fn': $!"; 
    my $raw_data = do { local $/; <$fh> }; 
    close $fh; 
    my $str = Encode::decode('utf-8', $raw_data, Encode::FB_QUIET); 
    my ($header, $last_line) = $str =~ /^(.*\n)([^\n]*)$/s; 
    my $line_no = $str =~ tr/\n//; 
    ++$line_no; 
    my $pos = (length $last_line) + 1; 
    warn "$err_msg, in file '$fn' (line: $line_no, pos: $pos)\n"; 
} 

sub write_test_file { 
    my ($fn) = @_; 

    my $bytes = "Hello\nA\x{E5}\x{61}"; # 2 lines ending in iso 8859-1: åa 
    open (my $fh, '>:raw', $fn) or die "Could not open file '$fn': $!"; 
    print $fh $bytes; 
    close $fh; 
} 

wyjściowa:

utf8 "\xE5" does not map to Unicode at ./p.pl line 27 
, in file 'test.txt' (line: 2, pos: 2) 
Segmentation fault (core dumped) 

Answer 1

Oto kolejny sposób, aby zlokalizować gdzie pożary ostrzegawcze, z niebuforowanej sysread

use warnings; 
use strict; 

binmode STDOUT, ':utf8'; 
binmode STDERR, ':utf8'; 

my $file = 'test.txt'; 
open my $fh, "<:encoding(utf-8)", $file or die "Can't open $file: $!"; 

$SIG{__WARN__} = sub { print "\t==> WARN: @_" }; 

my $char_cnt = 0;  
my $char; 

while (sysread($fh, $char, 1)) { 
    ++$char_cnt; 
    print "$char ($char_cnt)\n"; 
} 

Plik test.txt został napisany przez opublikowany program, z tym że musiałem go dodać, aby odtworzyć zachowanie - działa bez ostrzeżeń w wersji 5.10 i 5.16. Dodałem \x{234234} do końca. Numer linii można śledzić za pomocą $char =~ /\n/.

Po błędzie zwraca sysreadundef. Można go przenieść do ciała while (1), aby umożliwić kontynuowanie odczytywania i przechwytywanie wszystkich ostrzeżeń, zrywając na 0 (zwrócony w EOF).

Drukuje

 
H (1) 
e (2) 
l (3) 
l (4) 
o (5) 

(6) 
A (7) 
å (8) 
a (9) 
     ==> WARN: Code point 0x234234 is not Unicode, may not be portable at ... 
(10) 

Chociaż nie złapać znak ostrzega o, ponownego odczytu pliku przy użyciu Encode może okazać się lepszy niż sięgając sysread, w szczególności jeśli sysread wykorzystuje Encode.

Jednak Perl jest wewnętrznie utf8 i nie jestem pewien, czy sysread potrzebuje Encode.

Uwaga. Strona dla sysread wspiera jej stosowanie na danych z warstw kodowania

Note that if the filehandle has been marked as :utf8 Unicode characters are read instead of bytes (the LENGTH, OFFSET, and the return value of sysread are in Unicode characters). The :encoding(...) layer implicitly introduces the :utf8 layer. See binmode , open , and the open pragma.