Perl - regex - позиция первого не совпадающего символа

Question

Я хочу найти позицию в строке, где регулярное выражение перестает совпадать.

Простой пример:

my $x = 'abcdefghijklmnopqrstuvwxyz';
$x =~ /gho/;

В этом примере будет дана позиция символа 'h'потому что' h 'соответствует, а' o '- первый не совпадающий символ.

Я думал об использовании pos или $ - но он не записан при неудачном совпадении.Другое решение состоит в том, чтобы итеративно сокращать шаблон регулярных выражений до тех пор, пока он не будет соответствовать, но это очень уродливо и не работает со сложными шаблонами.мое ужасное объяснение.

Чтобы прояснить мою ситуацию: если вы думаете о регулярном выражении как конечном автомате, есть момент, когда тестирование прерывается, потому что символ не подходит.Это то, что я ищу.

Использование итеративного паратеза (как упомянул Евгений У) - хорошая идея, но оно не работает с квантификаторами, и мне пришлось редактировать шаблон.*

Есть ли другие идеи?

Answer 1

То, что вы предлагаете, сложно, но выполнимо .

Если я могу перефразировать то, что я понимаю, вы хотите узнать, как далеко неудачный матч попал в матч. Чтобы сделать это, вы должны быть в состоянии разобрать регулярное выражение.

Лучшим анализатором регулярных выражений, вероятно, является использование самого Perl с ключом командной строки -re=debug:

$ perl -Mre=debug -e'"abcdefghijklmnopqr"=~/gh[ijkl]{5}/'
Compiling REx "gh[ijkl]{5}"
Final program:
   1: EXACT <gh> (3)
   3: CURLY {5,5} (16)
   5:   ANYOF[i-l][] (0)
  16: END (0)
anchored "gh" at 0 (checking anchored) minlen 7 
Guessing start of match in sv for REx "gh[ijkl]{5}" against "abcdefghijklmnopqr"
Found anchored substr "gh" at offset 6...
Starting position does not contradict /^/m...
Guessed: match at offset 6
Matching REx "gh[ijkl]{5}" against "ghijklmnopqr"
   6 <bcdef> <ghijklmnop>    |  1:EXACT <gh>(3)
   8 <defgh> <ijklmnopqr>    |  3:CURLY {5,5}(16)
                                  ANYOF[i-l][] can match 4 times out of 5...
                                  failed...
Match failed
Freeing REx: "gh[ijkl]{5}"

Вы можете выложить эту командную строку Perl своим регулярным выражением и проанализировать возвращение stdout. Ищите `

Вот подходящее регулярное выражение:

$ perl -Mre=debug -e'"abcdefghijklmnopqr"=~/gh[ijkl]{3}/'
Compiling REx "gh[ijkl]{3}"
Final program:
   1: EXACT <gh> (3)
   3: CURLY {3,3} (16)
   5:   ANYOF[i-l][] (0)
  16: END (0)
anchored "gh" at 0 (checking anchored) minlen 5 
Guessing start of match in sv for REx "gh[ijkl]{3}" against "abcdefghijklmnopqr"
Found anchored substr "gh" at offset 6...
Starting position does not contradict /^/m...
Guessed: match at offset 6
Matching REx "gh[ijkl]{3}" against "ghijklmnopqr"
   6 <bcdef> <ghijklmnop>    |  1:EXACT <gh>(3)
   8 <defgh> <ijklmnopqr>    |  3:CURLY {3,3}(16)
                                  ANYOF[i-l][] can match 3 times out of 3...
  11 <ghijk> <lmnopqr>       | 16:  END(0)
Match successful!
Freeing REx: "gh[ijkl]{3}"

Вам потребуется создать синтаксический анализатор, который может обработать возврат из отладчика Perl re. Левая и правая угловые скобки показывают расстояние до строки, когда двигатель регулярных выражений пытается соответствовать.

Кстати, это нелегкий проект ...

Answer 2

Вы можете получить соответствующую часть и использовать функцию index, чтобы найти ее позицию:

my $x = 'abcdefghijklmnopqrstuvwxyz';

$x =~ /(g(h(o)?)?)/;
print index($x, $1) + length($1), "\n"; #8

Answer 3

Это похоже на работу.По сути, идея состоит в том, чтобы разделить регулярное выражение на составные части и попробовать их последовательно, возвращая последнюю совпадающую позицию.Фиксированные строки нужно разделить, но классы символов и квантификаторы можно хранить вместе.

В теории это должно работать, но может потребоваться настройка.

use v5.10;
use strict;
use warnings;

my $string = 'abcdefghijklmnopqrstuvwxyz';
my $match  = partial_match($string, qw(g h (?=i) [ijkx]+ [lmn]+ z));
say "match ended at pos $match, character ", substr($string,$match,1);

sub partial_match {
    my $string = shift;
    my @rx = @_;
    my $pos;
    if ($string =~ /$rx[0]/g) {
        $pos = pos $string;
        if (defined $rx[1]) {
            splice @rx, 0, 2, $rx[0] . $rx[1];
            $pos = partial_match($string, @rx) // $pos;
        } else { return $pos }
    } else {
        say "Didn't match $rx[0]";
        return;
    }
}

Answer 4

Я думаю, это именно то, для чего предназначена функция pos.ПРИМЕЧАНИЕ: pos работает только если вы используете флаг /g

my $x = 'abcdefghijklmnopqrstuvwxyz';
my $end = 0;
if( $x =~ /$ARGV[0]/g )
{
    $end = pos($x);
}
print "End of match is: $end\n";

Дает следующий вывод

[@centos5 ~]$ perl x.pl
End of match is: 0
[@centos5 ~]$ perl x.pl def
End of match is: 6
[@centos5 ~]$ perl x.pl xyz
End of match is: 26
[@centos5 ~]$ perl x.pl aaa
End of match is: 0
[@centos5 ~]$ perl x.pl ghi
End of match is: 9

Answer 5

Как насчет:

#!/usr/bin/perl 
use Modern::Perl;

my $x = 'abcdefghijklmnopqrstuvwxyz';
my $s = 'gho';
do {
    if ($x =~ /$s/) {
        say "$s matches from $-[0] to $+[0]";
    } else {
        say "$s doesn't match";
    }
} while chop $s;

выход:

gho doesn't match
gh matches from 6 to 8
g matches from 6 to 7
 matches from 0 to 0