试图改进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

\n\n

use warnings;\nuse strict;\n\nbinmode STDOUT, \':utf8\';\nbinmode STDERR, \':utf8\';\n\nmy $file = \'test.txt\';\nopen my $fh, "<:encoding(UTF-8)", $file or die "Can\'t open $file: $!";\n\n$SIG{__WARN__} = sub { print "\\t==> WARN: @_" };\n\nmy $char_cnt = 0;    \nmy $char;\n\nwhile (sysread($fh, $char, 1)) {\n    ++$char_cnt;\n    print "$char ($char_cnt)\\n";\n}\n

\n\n

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

\n\n

错误返回sysread。undef可以将其移至 的正文中，while (1)以允许继续读取并捕获所有警告，并在 EOF 上爆发0（在 EOF 上返回）。

\n\n

这打印

\n\n

\nH (1)\ne (2)\nl (3)\nl (4)\无 (5)\n\n (6)\nA (7)\n\xc3\xa5 (8)\na (9 )\n ==> 警告：代码点 0x234234 不是 Unicode，可能无法在 ...\n (10)\n 处移植

\n\n

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

\n\n

然而，Perl 是utf8内部的，我不确定是否sysread需要Encode。

\n\n

笔记。sysread页面支持在具有编码层的数据上使用

\n\n

\n

请注意，如果文件句柄已标记为:utf8Unicode，则读取字符而不是字节（LENGTH、OFFSET 和返回值sysread均采用 Unicode 字符）。\n :encoding(...)层隐式引入该:utf8层。\n 请参阅binmode、open和openpragma。

\n

\n\n\n\n

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

\n