Я испытываю интерфейс Брайана Хендерсона Perl к библиотеке ncurses: Curses
Для простого упражнения я пытаюсь получить отдельные символы, набранные на экране. Это напрямую основано на NCURSES Programming HOWTO , с адаптациями.
Когда я вызываю Perl библиотеку getchar(), я ожидаю получить символ, возможно многобайтовый (Это немного более сложный, как объяснено в этой части справочной страницы библиотеки , потому что нужно обрабатывать особые случаи функциональных клавиш и никакого ввода, но это только обычные сценарии).
Это подпрограмма read1ch() в приведенном ниже коде.
Это хорошо работает для символов ASCII, но не работает для символов выше 0x7F. Например, при нажатии è (Unicode 0x00E8, UTF-8 : 0xC3, 0xA8) я фактически получаю код 0xE8 вместо чего-то, закодированного в UTF-8. Распечатав его на терминал, для которого LANG=en_GB.UTF-8 не работает, и в любом случае я ожидал 0xC3A8.
Что мне нужно изменить, чтобы заставить его работать, т. Е. Получить è либо как правильный символ, либо как строку Perl?
Код C, снятый для getchar() это здесь кстати. Может, он просто не скомпилирован с 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 Проклятие шим сказано:
Если wget_wch() недоступно (т.е. библиотека Curses не понимает широких символов), это вызывает wgetch() [получить 1-байтовый символ из окна curses], но, тем не менее, возвращает значения, описанные выше. Это может быть проблемой, потому что с многобайтовой кодировкой символов, такой как UTF-8, вы получите две односимвольные строки для двухбайтового символа (например, «Ã» и «¤» для «ä»).
Это может быть и так, но wget_wch() существует в этой системе.
Приложение 3
Попытался увидеть, что делает код C и добавил fprintf непосредственно в многобайтовый код обработки curses/Curses-1.36/CursesFunWide.c, перекомпилирован, не удалось переопределить систему Curses.so моей собственной через LD_LIBRARY_PATH (почему нет? почему все работает только половину времени ?), поэтому заменил системную библиотеку прямо на месте (возьмите ЭТО!).
#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
Это просто жирная НОПЬ, при нажатии ü видно:
Obtained win_t 0x00fc
Таким образом, правильный код запускается , но данные ISO-8859-1 , не UTF-8. Так что wget_wch, который ведет себя плохо. Так что это проблема конфигурации проклятий. Да.
Приложение 4
Меня поразило, что, возможно, ncurses предполагал локаль по умолчанию, то есть C. Чтобы заставить ncurses работать с широкими символами, нужно «инициализировать локаль», что, вероятно, означает перемещение состояния из «неустановленного» (и, таким образом, ncurses возврат к C) в «настройку системы». указывает "(что должно быть в переменной среды LANG). Страница man для ncurses говорит:
Библиотека использует локаль, которую инициализировала вызывающая программа. Обычно это делается с помощью setlocale:
setlocale (LC_ALL, "");
Если языковой стандарт не инициализирован, библиотека предполагает, что символы могут быть напечатаны, как в ISO-8859-1, для работать с некоторыми устаревшими программами. Вы должны инициализировать локаль и не полагаться на конкретные c подробности библиотеки, когда локаль не была настроена.
Это тоже не сработало, но я чувствую, что решение заключается в том, что дорога.
Приложение 5
Код преобразования win_t (очевидно, такой же, как wchar_t) из CursesWide.c, преобразует wint_t (здесь рассматривается как wchar_t), полученный от wget_wch() в 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 -Курсы
- Пробовал с perl -Курсами-1,36-9.fc30.x86_64
- Пробовал с perl -Curses-1.36-11.fc31.x86_64
Если вы попробуете это, нажмите BACKSPACE, чтобы выйти из l oop, потому что 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
}