我怎样才能捕获“Unicode 非字符”警告？

Question

我怎样才能捕捉到“Unicode非字符0xffff对于交换是非法的”警告？

#!/usr/bin/env perl
use warnings;
use 5.012;
use Try::Tiny;

use warnings FATAL => qw(all);

my $character;

try {
    $character = "\x{ffff}";
} catch {
    die "---------- caught error ----------\n";
};

say "something";

输出：

# Unicode non-character 0xffff is illegal for interchange at ./perl1.pl line 11.

Answer 1

一个Perl 5.10.0 ⋯ 5.13.8   Bug

我假设您实际上并不想“捕获”此警告，而是想生存或忽略它。如果你真的想抓住它，那么，可能有更简单的方法。

但首先要知道的是，不存在非法代码点，只有不可互换的代码点。

您只需在需要使用完整 Unicode 范围（或更多）的范围内使用无警告“utf8”即可。 无需为此使用eval。所需的只是范围内的警告抑制。即使对于较新的 perls 来说这是不必要的。

因此，不要这样

$char = chr(0xFFFE);

写：（在较旧的 perls 上）：

$char = do { no warnings "utf8"; chr(0xFFFE) };

这也是涉及此类字符的模式匹配的情况：

 $did_match = do { no warnings "utf8" ; $char =~ $char);

将导致警告或致命错误，具体取决于您的 perl 的旧版本，或者根本没有任何结果，具体取决于您的 perl 的新版本佩尔群岛

您可以仅在重要的版本上以这种方式禁用与 utf8 相关的警告：

no if $^V < 5.13.9, qw<warnings utf8>;

“在下一个版本中修复”

真正有趣的是他们（阅读：Perl5 Porters，特别是 Karl Williamson）已经修复了需要没有警告“utf8” 保护只是为了与任何代码点一起工作。您可能需要小心的只是输出。注意：

% perl5.10.0 -Mwarnings=FATAL,all -E 'my $char = chr(0xFFFE); say "Ok"'
Unicode character 0xfffe is illegal at -e line 1.

% perl5.11.3 -Mwarnings=FATAL,all -E 'my $char = chr(0xFFFE); say "Ok"'
Unicode non-character 0xfffe is illegal for interchange at -e line 1.

% perl5.12.0 -Mwarnings=FATAL,all -E 'my $char = chr(0xFFFE); say "Ok"'
Unicode non-character 0xfffe is illegal for interchange at -e line 1.

% perl5.12.3 -Mwarnings=FATAL,all -E 'my $char = chr(0xFFFE); say "Ok"'
Unicode non-character 0xfffe is illegal for interchange at -e line 1.

% perl5.13.0 -Mwarnings=FATAL,all -E 'my $char = chr(0xFFFE); say "Ok"'
Unicode non-character 0xfffe is illegal for interchange at -e line 1.

% perl5.13.8 -Mwarnings=FATAL,all -E 'my $char = chr(0xFFFE); say "Ok"'
Unicode non-character 0xfffe is illegal for interchange at -e line 1.

% perl5.13.9 -Mwarnings=FATAL,all -E 'my $char = chr(0xFFFE); say "Ok"'
Ok

% perl5.13.10 -Mwarnings=FATAL,all -E 'my $char = chr(0xFFFE); say "Ok"'
Ok

最安全的做法是在您需要的地方放置no warnings "utf8"。但不需要eval！

从 5.13.10 开始，因此在 5.14 中，utf8 警告分为三个子类别：UTF-16 的 surrogate、如下所述的 nonchar 和 non_unicode< /code> 用于超级，也在下面定义。

All-Perl 交换是安全的

不过，您可能不想抑制输出中的“非法交换”警告，因为这是事实。好吧，除非您使用 Perl 的 "utf8" 编码，这与它的 "UTF-8" 编码不同，这很奇怪。 "utf8" 编码比正式标准更宽松，因为它允许我们做比其他方式更有趣的事情。

但是，当且仅当您拥有 100% 纯 Perl 数据路径时，您仍然可以使用您想要的任何代码点，包括高达 ᴍᴀxɪɴᴛ 的非 unicode 代码点。这在 32 位机器上是 0x7FFF_FFFF，而在 64 位机器上则大得难以形容：0xFFFF_FFFF_FFFF_FFFF！这不仅仅是一个超级；而是一个超级。这是一个超巨型！

% perl -Mwarnings -CS -E 'my $a = chr(0xFFFF_FFFF); say $a ' | 
  perl -Mwarnings -CS -nlE 'say "got ord ", ord'
Code point 0xFFFFFFFF is not Unicode, may not be portable at -e line 1.
got ord 4294967295

% perl -Mwarnings -CS -E 'no warnings "utf8"; my $a = chr(0xFFFF_FFFF); say $a' |
 perl -Mwarnings -CS -nlE 'say "got ord ", ord'
got ord 4294967295

% perl -Mwarnings -CS -E 'no warnings "utf8"; my $a = chr(0xFFFF_FFFF_FFFF_FFFF); say $a' |
  perl -Mwarnings -CS -nlE 'say "got ord ", ord'
Hexadecimal number > 0xffffffff non-portable at -e line 1.
got ord 18446744073709551615

% perl -Mwarnings -CS -E 'no warnings qw[ utf8 portable ]; my $a = chr(0xFFFF_FFFF_FFFF_FFFF);  say $a ' |
  perl -Mwarnings -CS -nlE 'say "got ord ", ord'
got ord 18446744073709551615

请注意，在 32 位机器上，最后一个会产生以下内容：

Integer overflow in hexadecimal number at -e line 1.
got ord 4294967295

各种非法交换的非字符

有几种（实际上是相当多）不同类别的代码点对于交换是非法的。

• 任何满足 (ord(ᴄᴏᴅᴇᴘᴏɪɴᴛ) & 0xFFFE) == 0xFFFE 为真的代码点。这涵盖了所有可能平面中的最后两个代码点。由于它跨越 17 个平面，因此 Unicode 定义了 34 个这样的代码点。这些不是字符，尽管它们是 Unicode 代码点。我们将这些称为“Penults”。它们属于 5.13.10 或更高版本的 nonchar 警告类别。

• 从 U+FDD0 开始的 32 个代码点。这些保证是非字符，尽管它们当然仍然是 Unicode 代码点。与之前的 Penult 集一样，这些也属于 5.13.10 或更高版本的 nonchar 警告类别。

• 1024 个高代理项和 1024 个低代理项，它们是作为斜率而被雕刻出来的，以使 UTF-16 对于所有尝试 UCS-2 而不是 UTF-8 或 UTF-32 的愚蠢系统成为可能。这削弱了有效 Unicode 代码点的范围，将它们限制为仅前 21 位。 代理仍然是代码点。它们只是无法互换，因为它们不能总是由聪明的 UTF-16 正确表示。在 5.13.10 或更高版本中，这些由 surrogate 警告子类控制。

• 除此之外，我们现在已经超出了 Unicode 范围。我将这些称为“超级”。在 32 位计算机上，除了 Unicode 提供的标准 21 位之外，您仍然拥有（10 或）11 位。 Perl 可以很好地使用这些。这给出了您可以在 Perl 程序中使用的总共 2**32 个代码点（好吧，或者至少 2**31，由于有符号溢出）。您将获得一百万个 Unicode 代码点，但随后您将获得超出 Perl 中可以使用的数十亿个超级代码点。如果您运行的是 5.13.10 或更高版本，则可以通过 non_unicode warnings 子类控制对这些内容的访问。

• 即使在超级范围内，Perl 仍然遵循有关 Penult 的规则。在 32 位机器上有 480 个这样的 Superpenult，而在 64 位机器上则更多。

• 如果您真的想要以不可移植的方式播放它，那么如果您有本机 64 位整数，那么您还有比 supers 提供的高出 32 或 33 位的位。您现在有 18 万亿、446 万亿、744 万亿、730 亿、7.09 亿、55.1 万和 616 个字符。您拥有一整艾字节不同的代码点！这远远超出了超级的范围，我将称它们为Hypermegas。好的，所以这些不是很便携，因为它们需要真正的 64 位平台。它们有点陌生，所以也许我们应该写成Ὑπέρμεγας来吓跑人们。 :) 请注意，禁止倒数的规则仍然适用于 hypermegas。

---

测试程序

我编写了一个小程序来证明这些代码点很酷。

testing Penults             passed all 34 codepoints
testing Super_penults       passed all 480 codepoints
testing Noncharacters       passed all 32 codepoints
testing Low_surrogates      passed all 1024 codepoints
testing High_surrogates     passed all 1024 codepoints
testing Supers              passed all 8 codepoints
testing Ὑπέρμεγας            passed all 10 codepoints

注意：上面的最后一行显示了 SO 的地狱突出显示代码中的另一个愚蠢的错误。注意到最后一个 WɪᴋɪWᴏʀᴅ 了，\p{Greek} 被排除在着色方案之外了吗？这意味着他们只寻找大写的 ASCII 标识符。 已经过时了！如果您不打算正确使用 \p{Uppercase} 之类的内容，为什么还要费心接受 ᴜɴɪᴄᴏᴅᴇ 呢？正如您将在我的程序中看到的那样，我有一个 @ὑπέρμεγας 数组，我们 ᴍᴏᴅᴇʀɴ ᴘʀᴏɢʀᴀᴍᴍɪɴɢ ʟᴀɴɢᴜᴀɢᴇs 可以很好地处理这个问题。 ☺

显然我没有运行所有的超级或超级。在 32 位机器上，您只能获得 4 个经过测试的 hyper。我也没有测试任何超级惩罚。

这是测试程序，它可以在 5.10 及更高版本的所有版本上正常运行。

#!/usr/bin/env perl
#
# hypertest - show how to safely use code points not legal for interchange in Perl
# 
# Tom Christiansen
# [email protected]
# Sat Feb 26 16:38:44 MST 2011

use utf8;
use 5.10.0;
use strict;
use if $] > 5.010, "autodie";
use warnings FATAL => "all";

use Carp;

binmode(STDOUT, ":utf8");
END { close STDOUT }

$\ = "\n";

sub ghex(_);

my @penults = map { 
    (0x01_0000 * $_) + 0xfffE, 
    (0x01_0000 * $_) + 0xfffF, 
} 0x00 .. 0x10;

my @super_penults = map { 
    (0x01_0000 * $_) + 0xfffE, 
    (0x01_0000 * $_) + 0xfffF, 
} 0x10 .. 0xFF;

my @low_surrogates  = map { 0xDC00 + $_ } 0x000 .. 0x3FF;
my @high_surrogates = map { 0xD800 + $_ } 0x000 .. 0x3FF;

my @noncharacters = map { 0xFDD0 + $_ } 0x00 .. 0x1F;

my @supers = ( 
    0x0011_0000,  0x0100_0000,  0x1000_0000,  0x1F00_0000,  
    0x1FFF_FFFF,  0x3FFF_FFFF,  0x7FFF_FFFF,  0x7FFF_FFFF,  
);

# these should always work anywhere 
my @ὑπέρμεγας = ( 
    0x8000_0000,   0xF000_0000,   
    0x3FFF_FFFF,   0xFFFF_FFFF,  
);

####
# now we go fishing for 64-bit ὑπέρμεγας
####

eval q{
    use warnings FATAL => "overflow";
    no  warnings "portable";
    push @ὑπέρμεγας => ( 
        0x01_0000_0000, 
        0x01_FFFF_FF00,
    );
};
eval q{
    use warnings FATAL => "overflow";
    no  warnings "portable";
    push @ὑπέρμεγας => (
        0x0001_0000_0000_0000,
        0x001F_0000_0000_0000,
        0x7FFF_FFFF_FFFF_FFFF,
        0xFFFF_FFFF_FFFF_FFFF,
    );
};

# more than 64??
eval q{
    use warnings FATAL => "overflow";
    no  warnings "portable";
    push @ὑπέρμεγας => (
        0x01_0001_0000_0000_0000,
        0x01_7FFF_FFFF_FFFF_FFFF,
        0x01_FFFF_FFFF_FFFF_FFFF,
    );
    1;
};


my @testpairs = (
    penults         => \@penults,
    super_penults   => \@super_penults,
    noncharacters   => \@noncharacters ,
    low_surrogates  => \@low_surrogates,
    high_surrogates => \@high_surrogates,
    supers          => \@supers,
    ὑπέρμεγας       => \@ὑπέρμεγας,   
);

while (my($name, $aref) = splice(@testpairs, 0, 2)) {
    printf "testing %-20s", ucfirst $name;

    my(@passed, @failed);

    for my $codepoint (@$aref) {

        use warnings FATAL => "all";

        my $char = do {
            # next line not needed under 5.13.9 or better: HURRAY!
            no warnings "utf8";
            chr(0xFFFF) && chr($codepoint);
        };

        my $regex_ok = do {
            # next line not needed under 5.13.9 or better: HURRAY!
            no warnings "utf8";
            $char =~ $char;
            1;
        };

        my $status = defined($char) && $regex_ok;

        push @{ $status ? \@passed : \@failed }, $codepoint;
    }

    my $total  = @$aref;
    my $passed = @passed;
    my $failed = @failed;

    given($total) {
        when ($passed)  { print "passed all $total codepoints" }
        when ($failed)  { print "failed all $total codepoints" }
        default         {
            print "of $total codepoints, failed $failed and passed $passed";
            my $flist = join(", ", map { ghex } @failed);
            my $plist = join(", ", map { ghex } @passed);
            print "\tpassed: $plist";
            print "\tfailed: $flist";
        }
    }

}

sub ghex(_) {
    my $num = shift();
    my $hex = sprintf("%X", $num);
    return $hex if length($hex) < 5;
    my $flip = reverse $hex;
    $flip =~ s<
        ( \p{ahex} \p{ahex} \p{ahex} \p{ahex} )
        (?= \p{ahex} )
        (?! \p{ahex}* \. )
    ><${1}_>gx;
    return "0x" . reverse($flip);
}

Answer 2

这是一个编译时错误，类似于忘记关闭正则表达式。如果您将该片段的编译延迟到运行时，您可以捕获它：

#!/usr/bin/env perl
use warnings;

use warnings FATAL => qw(all);

my $character;

eval q{
    $character = "\x{ffff}";
};
if ($@) {
    die "---------- caught error ----------\n";
}

print "something\n";

输出：

---------- caught error  ----------

如果您在 eval 之后删除 q，您将获得与脚本相同的行为现在，因为 eval {...}; if($@) {...} 与 try {...} catch {...}; 相同，但带有 q它是字符串的评估，这是完全不同的。

更新：
正如 Tom 指出也许应该在您设置或获取这些值的位置周围的狭窄范围内禁用该警告，并使用 no warnings qw(utf8) 。您可能仍然希望将 utf8 警告捕获为输出错误（或将数据发送到程序外部的任何其他内容）：

#!/usr/bin/env perl
use warnings FATAL => qw(all);

my $character;

eval {
    no warnings qw(utf8);
    $character = "\x{ffff}";
};
if ($@) {
    die "---------- caught error  ----------\n";
}

print "something\n";
eval {
    print "something $character else\n";
};
if ($@) {
    die "---------- caught output error  ----------\n";
}

输出：

something
---------- caught output error  ----------