试图改进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)
A (7)
å (8)
a (9)
        ==> WARN: Code point 0x234234 is not Unicode, may not be portable at ...
 (10)

虽然这确实抓住了警告的角色，但使用Encode重新阅读文件可能比达到sysread更好，特别是如果sysread使用Encode 。

但是，Perl在内部utf8，我不确定sysread是否需要Encode。

请注意。 sysread的页面支持将其用于带编码图层的数据

  

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