【发布时间】：2020-07-09 04:37:28
【问题描述】：
我正在试用 Bryan Henderson 的 ncurses 库的 Perl 接口：Curses
作为一个简单的练习，我尝试获取在屏幕上键入的单个字符。这直接基于NCURSES Programming HOWTO，并进行了改编。
当我调用 Perl 库的 getchar() 时，我希望收到一个字符，可能是多字节的（这有点复杂，正如 this part of the library manpage 中解释的那样，因为必须处理功能键和无输入的特殊情况，但是那只是通常的花饰）。
就是下面代码中的子程序read1ch()。
这适用于 ASCII 字符，但不适用于 0x7F 以上的字符。例如，当点击è (Unicode 0x00E8, UTF-8: 0xC3, 0xA8) 时，我实际上获得了代码 0xE8 而不是 UTF-8 编码的东西。将其打印到LANG=en_GB.UTF-8 不起作用的终端上，无论如何我期待0xC3A8。
我需要更改什么才能使其正常工作，即将è 作为正确的字符或 Perl 字符串？
为getchar() 截取的C 代码是here 顺便说一句。也许它只是没有用C_GET_WCH set 编译？如何发现？
附录
附录 1
尝试使用设置binmode
binmode STDERR, ':encoding(UTF-8)';
binmode STDOUT, ':encoding(UTF-8)';
这应该可以解决任何编码问题，因为终端期望并发送 UTF-8，但这没有帮助。
还尝试使用use open 设置流编码（不太确定此方法与上述方法之间的区别），但这也无济于事
use open qw(:std :encoding(UTF-8));
附录 2
Perl Curses shim 的手册页说：
如果
wget_wch()不可用（即 Curses 库不可用 理解宽字符），这调用wgetch()[得到一个1字节的字符 从一个诅咒窗口]，但返回 尽管如此，上述值。这可能是一个问题，因为 像 UTF-8 这样的多字节字符编码，您将收到两个 两字节字符的单字符字符串（例如，“Ô和“¤” “一种”）。
这里可能就是这种情况，但wget_wch() 确实存在于这个系统上。
附录 3
试图查看C代码做了什么，并在curses/Curses-1.36/CursesFunWide.c的多字节处理代码中直接添加了fprintf，重新编译，没有设法用我自己的通过LD_LIBRARY_PATH覆盖系统Curses.so（为什么不是吗？为什么一切都只工作了一半？），所以直接替换了系统库（拿那个！）。
#ifdef C_GET_WCH
wint_t wch;
int ret = wget_wch(win, &wch);
if (ret == OK) {
ST(0) = sv_newmortal();
fprintf(stderr,"Obtained win_t 0x%04lx\n", wch);
c_wchar2sv(ST(0), wch);
XSRETURN(1);
} else if (ret == KEY_CODE_YES) {
XST_mUNDEF(0);
ST(1) = sv_newmortal();
sv_setiv(ST(1), (IV)wch);
XSRETURN(2);
} else {
XSRETURN_UNDEF;
}
#else
这只是一个胖子 NOPE，当按下 ü 时会看到：
Obtained win_t 0x00fc
所以运行了正确的代码，但数据是ISO-8859-1，而不是UTF-8。所以它是wget_wch，它的行为很糟糕。所以这是一个诅咒配置问题。呵呵。
附录 4
让我感到震惊的是，ncurses 可能假设了默认语言环境，即C。要使其ncurses 使用宽字符，必须“初始化语言环境”，这可能意味着将状态从“未设置”（从而使ncurses 回退到C）到“设置为系统指示”（应该是 LANG 环境变量中的内容）。 ncurses 的手册页说：
库使用调用程序已初始化的语言环境。 这通常通过 setlocale 完成：
setlocale(LC_ALL, "");
如果语言环境未初始化，则库假定字符 可按 ISO-8859-1 打印，以与某些遗留程序一起使用。 您应该初始化语言环境，而不是依赖于 尚未设置语言环境时的库。
这也不起作用，但我觉得解决方案就在这条路上。
附录 5
来自CursesWide.c 的win_t（显然与wchar_t 相同）转换代码，将从wget_wch() 接收到的wint_t（此处视为wchar_t）转换为Perl 字符串。 SV 是“标量值”类型。
另见：https://perldoc.perl.org/perlguts.html
这里插入两个fprintf，看看发生了什么：
static void
c_wchar2sv(SV * const sv,
wchar_t const wc) {
/*----------------------------------------------------------------------------
Set SV to a one-character (not -byte!) Perl string holding a given wide
character
-----------------------------------------------------------------------------*/
if (wc <= 0xff) {
char s[] = { wc, 0 };
fprintf(stderr,"Not UTF-8 string: %02x %02x\n", ((int)s[0])&0xFF, ((int)s[1])&0xFF);
sv_setpv(sv, s);
SvPOK_on(sv);
SvUTF8_off(sv);
} else {
char s[UTF8_MAXBYTES + 1] = { 0 };
char *s_end = (char *)UVCHR_TO_UTF8((U8 *)s, wc);
*s_end = 0;
fprintf(stderr,"UTF-8 string: %02x %02x %02x\n", ((int)s[0])&0xFF, ((int)s[1])&0xFF, ((int)s[2])&0xFF);
sv_setpv(sv, s);
SvPOK_on(sv);
SvUTF8_on(sv);
}
}
使用 perl-Curses 测试代码
- 已尝试使用 perl-Curses-1.36-9.fc30.x86_64
- 已尝试使用 perl-Curses-1.36-11.fc31.x86_64
如果您尝试，请按 BACKSPACE 退出循环，因为 CTRL-C 不再被解释。
下面代码很多，但关键区域标有----- Testing：
#!/usr/bin/perl
# pmap -p PID
# shows the per process using
# /usr/lib64/libncursesw.so.6.1
# /usr/lib64/perl5/vendor_perl/auto/Curses/Curses.so
# Trying https://metacpan.org/release/Curses
use warnings;
use strict;
use utf8; # Meaning "This lexical scope (i.e. file) contains utf8"
use Curses; # On Fedora: dnf install perl-Curses
# This didn't fix it
# https://perldoc.perl.org/open.html
use open qw(:std :encoding(UTF-8));
# https://perldoc.perl.org/perllocale.html#The-setlocale-function
use POSIX ();
my $loc = POSIX::setlocale(&POSIX::LC_ALL, "");
# ---
# Surrounds the actual program
# ---
sub setup() {
initscr();
raw();
keypad(1);
noecho();
}
sub teardown {
endwin();
}
# ---
# Mainly for prettyprinting
# ---
my $special_keys = setup_special_keys();
# ---
# Error printing
# ---
sub mt {
return sprintf("%i: ",time());
}
sub ae {
my ($x,$fname) = @_;
if ($x == ERR) {
printw mt();
printw "Got error code from '$fname': $x\n"
}
}
# ---
# Where the action is
# ---
sub announce {
my $res = printw "Type any character to see it in bold! (or backspace to exit)\n";
ae($res, "printw");
return { refresh => 1 }
}
sub read1ch {
# Read a next character, waiting until it is there.
# Use the wide-character aware functions unless you want to deal with
# collating individual bytes yourself!
# Readings:
# https://metacpan.org/pod/Curses#Wide-Character-Aware-Functions
# https://perldoc.perl.org/perlunicode.html#Unicode-Character-Properties
# https://www.ahinea.com/en/tech/perl-unicode-struggle.html
# https://hexdump.wordpress.com/2009/06/19/character-encoding-issues-part-ii-perl/
my ($ch, $key) = getchar();
if (defined $key) {
# it's a function key
printw "Function key pressed: $key";
printw " with known alias '" . $$special_keys{$key} . "'" if (exists $$special_keys{$key});
printw "\n";
# done if backspace was hit
return { done => ($key == KEY_BACKSPACE()) }
}
elsif (defined $ch) {
# "$ch" should be a String of 1 character
# ----- Testing
printw "Locale: $loc\n";
printw "Multibyte output test: öüäéèà периоду\n";
printw sprintf("Received string '%s' of length %i with ordinal 0x%x\n", $ch, length($ch), ord($ch));
{
# https://perldoc.perl.org/bytes.html
use bytes;
printw sprintf("... length is %i\n" , length($ch));
printw sprintf("... contents are %vd\n" , $ch);
}
# ----- Testing
return { ch => $ch }
}
else {
# it's an error
printw "getchar() failed\n";
return {}
}
}
sub feedback {
my ($ch) = @_;
printw "The pressed key is: ";
attron(A_BOLD);
printw("%s\n","$ch"); # do not print $txt directly to make sure escape sequences are not interpreted!
attroff(A_BOLD);
return { refresh => 1 } # should refresh
}
sub do_curses_run {
setup;
my $done = 0;
while (!$done) {
my $bubl;
$bubl = announce();
refresh() if $$bubl{refresh};
$bubl = read1ch();
$done = $$bubl{done};
if (defined $$bubl{ch}) {
$bubl = feedback($$bubl{ch});
refresh() if $$bubl{refresh};
}
}
teardown;
}
# ---
# main
# ---
do_curses_run();
sub setup_special_keys {
# the key codes on the left must be called once to resolve to a numeric constant!
my $res = {
KEY_BREAK() => "Break key",
KEY_DOWN() => "Arrow down",
KEY_UP() => "Arrow up",
KEY_LEFT() => "Arrow left",
KEY_RIGHT() => "Arrow right",
KEY_HOME() => "Home key",
KEY_BACKSPACE() => "Backspace",
KEY_DL() => "Delete line",
KEY_IL() => "Insert line",
KEY_DC() => "Delete character",
KEY_IC() => "Insert char or enter insert mode",
KEY_EIC() => "Exit insert char mode",
KEY_CLEAR() => "Clear screen",
KEY_EOS() => "Clear to end of screen",
KEY_EOL() => "Clear to end of line",
KEY_SF() => "Scroll 1 line forward",
KEY_SR() => "Scroll 1 line backward (reverse)",
KEY_NPAGE() => "Next page",
KEY_PPAGE() => "Previous page",
KEY_STAB() => "Set tab",
KEY_CTAB() => "Clear tab",
KEY_CATAB() => "Clear all tabs",
KEY_ENTER() => "Enter or send",
KEY_SRESET() => "Soft (partial) reset",
KEY_RESET() => "Reset or hard reset",
KEY_PRINT() => "Print or copy",
KEY_LL() => "Home down or bottom (lower left)",
KEY_A1() => "Upper left of keypad",
KEY_A3() => "Upper right of keypad",
KEY_B2() => "Center of keypad",
KEY_C1() => "Lower left of keypad",
KEY_C3 () => "Lower right of keypad",
KEY_BTAB() => "Back tab key",
KEY_BEG() => "Beg(inning) key",
KEY_CANCEL() => "Cancel key",
KEY_CLOSE() => "Close key",
KEY_COMMAND() => "Cmd (command) key",
KEY_COPY() => "Copy key",
KEY_CREATE() => "Create key",
KEY_END() => "End key",
KEY_EXIT() => "Exit key",
KEY_FIND() => "Find key",
KEY_HELP() => "Help key",
KEY_MARK() => "Mark key",
KEY_MESSAGE() => "Message key",
KEY_MOUSE() => "Mouse event read",
KEY_MOVE() => "Move key",
KEY_NEXT() => "Next object key",
KEY_OPEN() => "Open key",
KEY_OPTIONS() => "Options key",
KEY_PREVIOUS() => "Previous object key",
KEY_REDO() => "Redo key",
KEY_REFERENCE() => "Ref(erence) key",
KEY_REFRESH() => "Refresh key",
KEY_REPLACE() => "Replace key",
KEY_RESIZE() => "Screen resized",
KEY_RESTART() => "Restart key",
KEY_RESUME() => "Resume key",
KEY_SAVE() => "Save key",
KEY_SBEG() => "Shifted beginning key",
KEY_SCANCEL() => "Shifted cancel key",
KEY_SCOMMAND() => "Shifted command key",
KEY_SCOPY() => "Shifted copy key",
KEY_SCREATE() => "Shifted create key",
KEY_SDC() => "Shifted delete char key",
KEY_SDL() => "Shifted delete line key",
KEY_SELECT() => "Select key",
KEY_SEND() => "Shifted end key",
KEY_SEOL() => "Shifted clear line key",
KEY_SEXIT() => "Shifted exit key",
KEY_SFIND() => "Shifted find key",
KEY_SHELP() => "Shifted help key",
KEY_SHOME() => "Shifted home key",
KEY_SIC() => "Shifted input key",
KEY_SLEFT() => "Shifted left arrow key",
KEY_SMESSAGE() => "Shifted message key",
KEY_SMOVE() => "Shifted move key",
KEY_SNEXT() => "Shifted next key",
KEY_SOPTIONS() => "Shifted options key",
KEY_SPREVIOUS() => "Shifted prev key",
KEY_SPRINT() => "Shifted print key",
KEY_SREDO() => "Shifted redo key",
KEY_SREPLACE() => "Shifted replace key",
KEY_SRIGHT() => "Shifted right arrow",
KEY_SRSUME() => "Shifted resume key",
KEY_SSAVE() => "Shifted save key",
KEY_SSUSPEND() => "Shifted suspend key",
KEY_SUNDO() => "Shifted undo key",
KEY_SUSPEND() => "Suspend key",
KEY_UNDO() => "Undo key"
};
for (my $f = 1; $f <= 64; $f++) {
$$res{KEY_F($f)} = "KEY_F($f)"
}
return $res
}
【问题讨论】：
-
在对模块了解不多的情况下，我没有看到启用流中的 uf8 编码？喜欢代码顶部的
use open qw(:std :encoding(UTF-8));？还是模块应该处理这个问题？ -
好吧，看来我不能轻易拥有那个版本（cpanm 安装被炸得很惨——也许我的 CentOS7 上的系统诅咒太旧了）。必须在流上设置编码，是的；问题是图书馆是否这样做。不过很容易尝试：只需在程序顶部添加我的第一条评论中的行。见open pragma
-
binmode和openpragma 之间的区别我想说的是，open是一种比binmode更干净的方法，它可以处理所有标准流（ pragma 也是词法的）；代码中显示的binmode行没有处理STDIN。然后，如果还有其他输入通道（比如@ARGV、套接字...），您将需要Encode::decode或等效项。 -
但是从表面上看
getchar应该处理它；那么你也不想自己做。 -
decode("iso-8859-1", $x")没有意义。这是一个无操作。 （它可能会创建一个具有不同内部格式的字符串，但没有人应该关心这一点。这表明 elsewhere 存在错误。）
标签： perl encoding utf-8 locale ncurses