perl - 尝试改进 Encode::decode 警告消息:$SIG{__WARN__} 处理程序中的 Segfault

Question

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

我首先尝试使用 $SIG{__WARN__} 来解决这个问题。处理程序(这可能不是一个好主意)，但我得到了一个段错误。可能是一个愚蠢的错误，但我无法弄清楚:

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

输出:

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

这是另一种定位警告触发位置的方法，未缓冲 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/ 跟踪行号.
sysread返回 undef关于错误。可以移动到 while (1)的正文中允许读取继续并捕获所有警告，在 0 上爆发(在 EOF 上返回)。

这打印

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

(6)
一个 (7)
(8)
(9)
==> 警告:代码点 0x234234 不是 Unicode，可能无法在 ...
(10)

虽然这确实捕获了警告的字符，但使用 Encode 重新读取文件可能比到达 sysread 更好, 特别是如果 sysread使用 Encode .

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

笔记。 sysread 的页面支持将其用于具有编码层的数据

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.

备注 显然，在某个版本之后，事情已经发生了变化 sysread不支持编码层 .上面的链接，虽然对于旧版本(一个是 v5.10)确实显示了引用的内容，但新版本告诉我们会有异常(exception)。