Re: [знатокам perl] русский в регулярных выражениях (bug#486877)
В Sat, 6 Nov 2010 13:17:17 +0300
Victor Wagner <vitus@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";}
}
yuray@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
Reply to: