Как совместить строку с диакритикой в perl?
Например, сопоставьте "Nation" в "Îñţérñåţîöñåļîžåţîöñ" без дополнительных модулей. Возможно ли это в новых версиях Perl (5.14, 5.15 и т.д.)?
Я нашел ответ! Благодаря tchrist
Реальное решение с совпадением UCA (thnx до https://stackoverflow.com/users/471272/tchrist).
# found start/end offsets for matched utf-substring (without intersections)
use 5.014;
use strict;
use warnings;
use utf8;
use Unicode::Collate;
binmode STDOUT, ':encoding(UTF-8)';
my $str = "Îñţérñåţîöñåļîžåţîöñ" x 2;
my $look = "Nation";
my $Collator = Unicode::Collate->new(
normalization => undef, level => 1
);
my @match = $Collator->match($str, $look);
if (@match) {
my $found = $match[0];
my $f_len = length($found);
say "match result: $found (length is $f_len)";
my $offset = 0;
while ((my $start = index($str, $found, $offset)) != -1) {
my $end = $start + $f_len;
say sprintf("found at: %s,%s", $start, $end);
$offset = $end + 1;
}
}
Неправильное (но работающее) решение от http://www.perlmonks.org/?node_id=485681
Волшебная часть кода:
$str = Unicode::Normalize::NFD($str); $str =~ s/\pM//g;
Пример кода :
use 5.014;
use utf8;
use Unicode::Normalize;
binmode STDOUT, ':encoding(UTF-8)';
my $str = "Îñţérñåţîöñåļîžåţîöñ";
my $look = "Nation";
say "before: $str\n";
$str = NFD($str);
# M is short alias for \p{Mark} (http://perldoc.perl.org/perluniprops.html)
$str =~ s/\pM//og; # remove "marks"
say "after: $str";¬
say "is_match: ", $str =~ /$look/i || 0;
Ответы
Ответ 1
Правильное решение с UCA (thnx до tchrist):
# found start/end offsets for matched s
use 5.014;
use utf8;
use Unicode::Collate;
binmode STDOUT, ':encoding(UTF-8)';
my $str = "Îñţérñåţîöñåļîžåţîöñ" x 2;
my $look = "Nation";
my $Collator = Unicode::Collate->new(
normalization => undef, level => 1
);
my @match = $Collator->match($str, $look);
say "match ok!" if @match;
P.S.
"Кодекс, который предполагает, что вы можете удалить диакритические знаки, чтобы получить в базе буквы ASCII, является злым, все еще, сломанным, поврежденным мозгом, неправильным и оправданием смертной казни".
© tchrist Почему современный Perl предотвращает UTF-8 по умолчанию?
Ответ 2
Что вы подразумеваете под "без дополнительных модулей"?
Вот решение с use Unicode::Normalize;
см. в perl doc
Я удалил "ţ" и "ļ" из вашей строки, мое затмение не захотело сохранить script с ними.
use strict;
use warnings;
use UTF8;
use Unicode::Normalize;
my $str = "Îñtérñåtîöñålîžåtîöñ";
for ( $str ) { # the variable we work on
## convert to Unicode first
## if your data comes in Latin-1, then uncomment:
#$_ = Encode::decode( 'iso-8859-1', $_ );
$_ = NFD( $_ ); ## decompose
s/\pM//g; ## strip combining characters
s/[^\0-\x80]//g; ## clear everything else
}
if ($str =~ /nation/) {
print $str . "\n";
}
Выходной сигнал
Интернационализация
"ž" удаляется из строки, кажется, что это не скомпонованный символ.
Код для цикла for с этой стороны Как удалить диакритические знаки из символов
Еще одно интересное сообщение: Абсолютный минимум Каждый разработчик программного обеспечения Абсолютно, положительно должен знать о Unicode и наборах символов (без отговорок!) от Joel Spolsky
Update:
Как отметил @tchrist, существует алгоритм, который лучше подходит, называется UCA (Unicode Collation Algorithm). @nordicdyno, уже предоставил реализацию в своем вопросе.
Алгоритм описан здесь Unicode Technical Standard # 10, Unicode Collation Algorithm
модуль perl описан здесь на perldoc.perl.org