Как сопоставить строку с диакритическим знаком в Perl? - PullRequest
Новая
       7

Как сопоставить строку с диакритическим знаком в Perl?

23 голосов
/ 15 сентября 2011

Например, сопоставьте «Nation» в «« Îñţérñåţîöñåļîžåţîöñ »без дополнительных модулей. Возможно ли это в новых версиях Perl (5.14, 5.15 и т. Д.)?

Я нашел ответ! Спасибо tchrist

Правильное решение с соответствием UCA (от thxx до 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;

Ответы [ 2 ]

7 голосов
/ 16 сентября 2011

Правильное решение с UCA (от thxx до 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?

6 голосов
/ 15 сентября 2011

Что вы подразумеваете под "без дополнительных модулей"?

Вот решение с use Unicode::Normalize; см. На perl doc

Я удалил "ţ"и "ļ" из вашей строки, мое затмение не хотело сохранять сценарий с ними. 

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 находится с этой стороны Как удалить диакритические знаки из символов

Еще одно интересное прочтение: Абсолютный минимум, который должен знать каждый разработчик программного обеспечения Абсолютно, положительно должен знать о юникоде и наборах символов (без извинений!) от Джоэла Спольски

Обновление:

Как указывал @tchrist, существует алгоритм, который лучше подходит, называется UCA (Unicode Collation Algorithm).@nordicdyno, уже предоставил реализацию в своем вопросе.

Алгоритм описан здесь Технический стандарт Unicode # 10, алгоритм сопоставления Unicode

модуль perl описан здесь perldoc.perl.org

...