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

在对执行调试时，我问自己：如何找到可以在给定Unicode代码点的

\N{}

中使用的所有值

---

例如，我想知道U+03B1（希腊文小写字母ALPHA）的所有别名。我如何发现

\N{希腊文：alpha}

可用于此目的？

没有一个列表可用于检查这些内容

基于

\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;
}

注:

• charnames.pm导入参数中的脚本名称不区分大小写

• 的实例使用charnamesqw（）（即加载charnames.pm而不带参数的指令）

• 自Perl 5.16以来，charnames.pm是使用

  use charnames qw（：full:short）隐式加载的如果在遇到
  \N{}
  之前加载它

• 未列出有效的自定义别名。（从技术上讲，除非您修改脚本，否则不会出现任何错误。）
• 名称必须与输出完全相同，但以下情况除外：

  • U+

    后面的数字不区分大小写

  • U+

    后面的数字可能有前导零

  • ：short

    名称中的脚本名称不区分大小写

  • ：short

    和脚本中的大写字符名称不区分大小写，但必须至少包含一个大写字符
  • 使用

    使用字符名qw（：松散）允许显示字符串的进一步变化

---

相关：（最初标记为重复，但听起来像是您要求在

\N{}

中为该代码点使用所有东西，而不仅仅是Unicode别名）@ThisSuitesBlack不，不完全是<代码>希腊语：alpha是Perl生成的东西；它不是（直接）来自UCD。@ikegami是的，只是收回了我的投票。@ThisSuit是黑色的，不是，它与UCD无关，只是它使用它。我可以把CPAN放在一个单独的模块中，但它的用途非常有限，因为它不能产生任何可比性。这有点像要求一个sub生成一个正则表达式模式将匹配的所有字符串。我发布的函数只不过是document

\N{}

，即使如此，它也只会在所有附带的注释中这样做，这些注释都比

\N{}

的实际注释长。太棒了！正是我要找的

$ ./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}"