В Sat, 6 Nov 2010 13:17:17 +0300 Victor Wagner <vi...@wagner.pp.ru> пишет:
> On 2010.11.06 at 10:59:05 +0300, Yuri Kozlov wrote: > > > Здравствуйте. > > > > Ошибка #486877 в adduser наблюдается и для русского языка. > > Знатоки perl, подскажите как нужно правильно написать тестовую > > программку (или может сразу исправите багу?), > > чтобы она правильно отрабатывала (взято из debian-l10-russian@). > > > > use utf8; > > require POSIX; > > import POSIX qw(setlocale); > > require I18N::Langinfo; > > import I18N::Langinfo qw(langinfo YESEXPR NOEXPR); > > > > setlocale(LC_ALL, ""); > > > > my $yesexpr = langinfo(YESEXPR()); > > my $noexpr = langinfo(NOEXPR()); > > > > foreach my $c ('y', 'Y', 'n', 'N', 'д', 'Д', 'н', 'Н', 'ж') { > > if ($c =~ m/$yesexpr/o) {print "$c match $yesexpr\n";} > > if ($c !~ m/$yesexpr/o) {print "$c not match $yesexpr\n";} > > if ($c =~ m/$noexpr/o) {print "$c match $noexpr\n";} > > if ($c !~ m/$noexpr/o) {print "$c not match $noexpr\n";} > > } > > > > результат: > > > > y match ^[ДдYy].* > > y not match ^[НнNn].* > > Y match ^[ДдYy].* > > Y not match ^[НнNn].* > > n not match ^[ДдYy].* > > n match ^[НнNn].* > > N not match ^[ДдYy].* > > N match ^[НнNn].* > > Wide character in print at t.perl line 14. > > И так, что мы видим - во-первых, perl не может корректно вывести > русскую букву 'Д' в STDOUT. > > Надо до первого print добавить binmode STDOUT,":utf8"; > > Сказав это, мы видим что yesexpr и noexpr выводятся как какая-то фигня > из облати latin-1, а не как русские буквы. > > То есть perl трактует полученные из langinfo строки как строки байт, а > не как строки символов. Отсюда и все проблемы. > > Соответственно, добавляем в начале скрипта > > use Encode qw(decode); > > и оборачиваем вызовы langinfo в decode > > my $yesexpr = decode("utf8",langinfo(YESEXPR())); > my $noexpr = decode("utf8",langinfo(NOEXPR())); > > Фактически этот вызов decode сводится к "проинтерпетировать данную в > качестве второго аргумента последовательность байт как строчку в utf-8". > Результатом будет строка символов, при текущей реализации идентичная > входной строке байт, но заметно отличающаяся с точки зрения perl по > смыслу. > > Теперь у нас все радостно работает до тех пор пока локаль использует > кодировку utf-8. В реальном приложении, где ответы вводятся в stdin, > придется еще и binmode на STDIN сказать. > > Добиться работы данной тестовой программы во всех русских локалях > (koi8-r, cp1251, ibm-866) будет несколько сложнее. > > Я сейчас сходу не вспомню, есть ли магическое слово, заставляющее потоки > ввода-вывода работать в кодировке текущей локали, или придется из > langinfo запрашивать кодировку и руками вкручивать ее в binmode (и > выдачу langinfo декодировать из этой кодировки, естественно). > > Возможно, дешевле будет проверять только на кодировку равную utf-8, и в > таких локалях работать через честное преобразование и выражений, и > проверяемых значений к строкам символов (потому что регексп с диапазоном > в русских букв в квадратных скобках, заданный в utf-8 и > проинтерпретированный как набор байт, ожидаемого результата не даст), а > в остальных случаях - наоборот форсированно загонять stdin и stdout в > режим :bytes - тогда на всех 8-битных кодировках все отработает как > ожидалось. Но в последнем случае жалко бедных жителей Дальнего Востока, > у которых есть многобайтовые кодировки, отличные от utf-8. Угум, теперь правильно. Осталось побороть привязку к utf8. Но неужели всё так действительно через ...? use utf8; use Encode qw(decode); require POSIX; import POSIX qw(setlocale); require I18N::Langinfo; import I18N::Langinfo qw(langinfo YESEXPR NOEXPR); setlocale(LC_ALL, ""); binmode(STDOUT,':utf8'); binmode(STDIN,':utf8'); my $yesexpr = langinfo(YESEXPR()); my $noexpr = langinfo(NOEXPR()); my $yesexpr = decode("utf8",langinfo(YESEXPR())); my $noexpr = decode("utf8",langinfo(NOEXPR())); foreach my $c ('y', 'Y', 'n', 'N', 'д', 'Д', 'н', 'Н', 'ж') { if ($c =~ m/$yesexpr/o) {print "$c match $yesexpr\n";} if ($c !~ m/$yesexpr/o) {print "$c not match $yesexpr\n";} if ($c =~ m/$noexpr/o) {print "$c match $noexpr\n";} if ($c !~ m/$noexpr/o) {print "$c not match $noexpr\n";} } yu...@keeper:/tmp$ perl t.perl y match ^[ДдYy].* y not match ^[НнNn].* Y match ^[ДдYy].* Y not match ^[НнNn].* n not match ^[ДдYy].* n match ^[НнNn].* N not match ^[ДдYy].* N match ^[НнNn].* д match ^[ДдYy].* д not match ^[НнNn].* Д match ^[ДдYy].* Д not match ^[НнNn].* н not match ^[ДдYy].* н match ^[НнNn].* Н not match ^[ДдYy].* Н match ^[НнNn].* ж not match ^[ДдYy].* ж not match ^[НнNn].* -- Best Regards, Yuri Kozlov -- To UNSUBSCRIBE, email to debian-russian-requ...@lists.debian.org with a subject of "unsubscribe". Trouble? Contact listmas...@lists.debian.org Archive: http://lists.debian.org/20101106133824.1f1af...@keeper.home.local