perl - 如何获取可在\N{} 中使用以生成特定代码点的所有值？

Question

对this question执行调试时，我问自己:如何找到给定 Unicode 代码点的 \N{} 中可以使用的所有值？

例如，我想知道 U+03B1(希腊小写字母)的所有别名。我如何知道 \N{greek:alpha} 可以用于此目的？

Answer 1

没有单独的列表来检查这些内容。

基于documentation \N{}，以下内容即可解决问题:

use List::Util   qw( max );
use Unicode::UCD qw( charscripts charinfo charprop );

my $re_scripts = join '|', map { quotemeta uc s/_/ /gr } keys %{ charscripts() };
my $re_letter = qr/^($re_scripts) (?:(CAPITAL|SMALL) )?LETTER (\S.*)/;

{
   @ARGV == 1
     or die("usage\n");

   my $ucp = hex( $ARGV[0] =~ s/^(?:U\+|0x)//r );

   my @names;
   push @names, [ "", sprintf('U+%X', $ucp) ];

   if ( my $charinfo = charinfo($ucp) ) {
      my $name = $charinfo->{name};
      push @names, [ ":full", $name ] if length($name) && $name ne '<control>';

      for my $alias (map s/:.*//sr, split /,/, charprop($ucp, 'Name_Alias')) {
         push @names, [ ":full", $alias ];
      }

      if ( my ($script_name, $type, $short_char_name) = $name =~ $re_letter ) {
         my $uc = ( $type // 'CAPITAL' ) eq 'CAPITAL';
         my $lc = ( $type // 'SMALL'   ) eq 'SMALL';
         push @names, [ ":short", join(":", $script_name, uc($short_char_name)) ] if $uc;
         push @names, [ ":short", join(":", $script_name, lc($short_char_name)) ] if $lc;
         push @names, [ $script_name, uc($short_char_name) ] if $uc;
         push @names, [ $script_name, lc($short_char_name) ] if $lc;
      }
   }

   my $longuest = max map length($_->[0]), @names;
   say sprintf("use charnames qw( %-*s ); \"\\N{%s}\"", $longuest, @$_) for @names;
}

例如，

$ ./script.pl U+03B1
use charnames qw(        ); "\N{U+3B1}"
use charnames qw( :full  ); "\N{GREEK SMALL LETTER ALPHA}"
use charnames qw( :short ); "\N{GREEK:alpha}"
use charnames qw( GREEK  ); "\N{alpha}"

$ ./script.pl U+0391
use charnames qw(        ); "\N{U+391}"
use charnames qw( :full  ); "\N{GREEK CAPITAL LETTER ALPHA}"
use charnames qw( :short ); "\N{GREEK:ALPHA}"
use charnames qw( GREEK  ); "\N{ALPHA}"

$ perl a.pl 1C00
use charnames qw(        ); "\N{U+1C00}"
use charnames qw( :full  ); "\N{LEPCHA LETTER KA}"
use charnames qw( :short ); "\N{LEPCHA:KA}"
use charnames qw( :short ); "\N{LEPCHA:ka}"
use charnames qw( LEPCHA ); "\N{KA}"
use charnames qw( LEPCHA ); "\N{ka}"

$ ./script.pl 20
use charnames qw(       ); "\N{U+20}"
use charnames qw( :full ); "\N{SPACE}"
use charnames qw( :full ); "\N{SP}"

注释:

• charnames.pm 导入参数中的脚本名称不区分大小写。
• 输出中的 use charnames qw( ); 实例(即不带参数加载 charnames.pm 的指令)实际上并不是必需的。
• 自 Perl 5.16 起，如果在遇到 \N{} 之前加载 charnames.pm，则使用 use charnames qw( :full :short ); 隐式加载 charnames.pm .
• 未列出有效的自定义别名。 (从技术上讲，除非您修改脚本，否则不会有任何问题。)
• 提供的名称必须与输出完全相同，但以下情况除外:
  • U+ 后面的数字不区分大小写。
  • U+ 后面的数字可能有前导零。
  • :short 名称中的脚本名称不区分大小写。
  • :short 和脚本字符名称中的大写字符名称不区分大小写，但必须至少包含一个大写字符。
  • 使用 use charnames qw( :loose ); 允许显示的字符串有更多变化。