尝试改进 Encode::decode 警告消息：$SIG{__WARN__} 处理程序中的段错误

我正在尝试改进发出的警告消息Encode::decode() https://metacpan.org/pod/Encode#FB_WARN。我希望它打印正在读取的文件的名称以及在该文件中找到格式错误的数据的行号，而不是打印模块的名称和模块中的行号。对于开发人员来说，原始消息可能很有用，但对于不熟悉 Perl 的最终用户来说，它可能毫无意义。最终用户可能更想知道哪个文件出现了问题。

我首先尝试使用$SIG{__WARN__} http://perldoc.perl.org/functions/warn.html处理程序（这可能不是一个好主意），但我遇到了段错误。可能是一个愚蠢的错误，但我无法弄清楚：

#! /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;
}

Output:

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

这是定位警告触发位置的另一种方法，使用无缓冲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";
}

文件test.txt是由发布的程序编写的，只是我必须添加它才能重现该行为 - 它在 v5.10 和 v5.16 上运行时没有警告。我添加了\x{234234}到最后。可以通过以下方式跟踪行号$char =~ /\n/.

The sysread回报undef出错时。它可以被移动到身体里while (1)允许读取继续并捕获所有警告，突破0（在 EOF 时返回）。

这打印

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)
  

虽然这确实捕获了警告的字符，但使用以下命令重新读取文件Encode可能比伸手去拿更好sysread，特别是如果sysread uses Encode.

然而，Perl 是utf8在内部，我不确定sysread needs Encode.

笔记。该页面为sysread http://perldoc.perl.org/functions/sysread.html支持其在具有编码层的数据上的使用

请注意，如果文件句柄已标记为:utf8统一码 读取的是字符而不是字节（LENGTH、OFFSET 和 返回值sysread是 Unicode 字符）。这:encoding(...)层隐含地引入了:utf8层。 看binmode, open，以及open pragma.

Note显然，在某个版本之后事情已经发生了变化sysread不支持编码层。上面的链接对于旧版本（其中一个是 v5.10）确实显示了引用的内容，而新版本则告诉我们会有例外。