我怎样才能捕捉到“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";

Output:

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

Perl 5.10.0 ⋯ 5.13.8 错误

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

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

你只需要使用一个no warnings "utf8"了解需要使用完整 Unicode 范围（或更多）的范围。无需使用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）修复了需要no warnings "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 警告分为三个子类别：surrogate对于 UTF-16，nonchar如下所述，并且non_unicode对于超级，也定义如下。

All-Perl 交换是安全的

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

However，当且仅当您拥有 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。他们属于nonchar2010 年 13 月 5 日或更高级别的警告级别。

• 从 U+FDD0 开始的 32 个代码点。这些保证是非字符，当然它们仍然是 Unicode 代码点。与之前的倒数集一样，这些也属于nonchar2010 年 13 月 5 日或更高级别的警告级别。

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

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

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

• If you really如果您想以不可移植的方式播放它，那么如果您有本机 64 位整数，那么您还可以在超级提供给您的基础上再获得 32 或 33 位。您现在有 18 万亿、446 万亿、744 万亿、730 亿、7.09 亿、55.1 万和 616 个字符。你有整个艾字节 of distinct码点！这远远超出了我所说的“超级”超巨型。好的，所以它们不太便携，因为它们需要真正的 64 位平台。它们有点陌生，所以也许我们应该这样写Ὑπέρμεγας来吓跑人们。 :) 请注意，反对 penults 的规则仍然适用于 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

NOTE：上面的最后一行显示了 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] /cdn-cgi/l/email-protection
# 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);
}