Как я могу заменить n-ное совпадение в регулярном выражении Perl? - PullRequest
Новая
       19

Как я могу заменить n-ное совпадение в регулярном выражении Perl?

4 голосов
/ 31 марта 2010

В ответ на предыдущий вопрос о извлечении n-го совпадения регулярного выражения , теперь мне нужно заменить совпадение, если оно найдено.

Я думал, что мог бы определить подпрограмму извлечения и вызвать ее в подстановке с модификатором /e. Я был явно неправ (по общему признанию, у меня была проблема XY ). 

use strict;
use warnings;

sub extract_quoted { # à la codaddict

        my ($string, $index) = @_;
        while($string =~ /'(.*?)'/g) {
                $index--;
                return $1 if(! $index);
        }
        return;
}

my $string = "'How can I','use' 'PERL','to process this' 'line'";

extract_quoted ( $string, 3 );
$string =~ s/&extract_quoted($string,2)/'Perl'/e;

print $string; # Prints 'How can I','use' 'PERL','to process this' 'line'

Есть, конечно, много других проблем с этой техникой:

  • Что делать, если на разных позициях встречаются одинаковые совпадения?
  • Что если совпадение не найдено?

В свете этой ситуации мне интересно, как это можно реализовать.

Ответы [ 5 ]

4 голосов
/ 31 марта 2010

РЕДАКТИРОВАТЬ: leonbloy первым предложил это решение. Если у вас возникнет соблазн поднять это, сначала проголосуйте против leonbloy.

В некоторой степени вдохновлен (ранее) leonbloy ответ: 

$line = "'How can I','use' 'PERL' 'to process this';'line'";
$n = 3;
$replacement = "Perl";

print "Old line: $line\n";
$z = 0;
$line =~ s/'(.*?)'/++$z==$n ? "'$replacement'" : "'$1'"/ge;
print "New line: $line\n";

Old line: 'How can I','use' 'PERL' 'to process this';'line'
New line: 'How can I','use' 'Perl' 'to process this';'line'
3 голосов
/ 31 марта 2010

Или вы можете сделать что-то, как это 

use strict;
use warnings;

my $string = "'How can I','use' .... 'perl','to process this' 'line'";

my $cont =0;
sub replacen { # auxiliar function: replaces string if incremented counter equals $index
        my ($index,$original,$replacement) = @_;
        $cont++;
        return $cont == $index ? $replacement: $original;
}

#replace the $index n'th match (1-based counting) from $string by $rep
sub replace_quoted {
        my ($string, $index,$replacement) = @_;
        $cont = 0; # initialize match counter
        $string =~ s/'(.*?)'/replacen($index,$1,$replacement)/eg;
        return $string;
}

my $result = replace_quoted ( $string, 3 ,"PERL");
print "RESULT: $result\n";

Немного безобразная "глобальная" переменная $ cont, которую можно отполировать, но вы поняли.

Обновление: более компактная версия: 

use strict;
my $string = "'How can I','use' .... 'perl','to process this' 'line'";

#replace the $index n'th match (1-based counting) from $string by $replacement
sub replace_quoted {
        my ($string, $index,$replacement) = @_;
        my $cont = 0; # initialize match counter
        $string =~ s/'(.*?)'/$cont++ == $index ? $replacement : $1/eg;
        return $string;
}

my $result = replace_quoted ( $string, 3 ,"PERL");
print "RESULT: $result\n";
0 голосов
/ 01 апреля 2010

Переработка ответа на предыдущий вопрос , совпадение n -1, а затем замена следующего. Шаблоны запоминания избавляют бедного Perl от необходимости перекомпилировать одни и те же шаблоны снова и снова. 

my $_quoted = qr/'[^']+'/; # ' fix Stack Overflow highlighting
my %_cache;
sub replace_nth_quoted { 
  my($string,$index,$replace) = @_;
  my $pat = $_cache{$index} ||=
    qr/ ^
        (                    # $1
          (?:.*?$_quoted.*?) # match quoted substrings...
            {@{[$index-1]}}  # $index-1 times
        )
        $_quoted             # the ${index}th match
      /x;

  $string =~ s/$pat/$1$replace/;
  $string;
}

Например 

my $string = "'How can I','use' 'PERL','to process this' 'line'";
print replace_nth_quoted($string, 3, "'Perl'"), "\n";

выходы 

'How can I','use' 'Perl','to process this' 'line'
0 голосов
/ 01 апреля 2010

См. perldoc perlvar : 

use strict; use warnings;

use Test::More tests => 5;

my %src = (
    q{'I want to' 'extract the word' 'PERL','from this string'}
    => q{'I want to' 'extract the word' 'Perl','from this string'},
    q{'What about', 'getting','PERL','from','here','?'}
    => q{'What about', 'getting','Perl','from','here','?'},
    q{'How can I','use' 'PERL','to process this' 'line'}
    => q{'How can I','use' 'Perl','to process this' 'line'},
    q{Invalid} => q{Invalid},
    q{'Another invalid string'} => q{'Another invalid string'}
);

while ( my ($src, $target) = each %src ) {
    ok($target eq subst_n($src, 3, 'Perl'), $src)
}

sub subst_n {
    my ($src, $index, $replacement) = @_;
    return $src unless $index > 0;
    while ( $src =~ /'.*?'/g ) {
        -- $index or return join(q{'},
            substr($src, 0, $-[0]),
            $replacement,
            substr($src, $+[0])
        );
    }
    return $src;
}

Выход: 

C:\Temp> pw
1..5
ok 1 - 'Another invalid string'
ok 2 - 'How can I','use' 'PERL','to process this' 'line'
ok 3 - Invalid
ok 4 - 'What about', 'getting','PERL','from','here','?'
ok 5 - 'I want to' 'extract the word' 'PERL','from this string'

Конечно, вам нужно решить, что произойдет, если будет передан недействительный $index или если требуемое совпадение не найдено. Я просто возвращаю исходную строку в коде выше.

0 голосов
/ 31 марта 2010

Если регулярное выражение не слишком сложнее, чем у вас, вы можете выполнить split с правкой и join: 

$line = "'How can I','use' 'PERL','to process this' 'line'";

$n = 3;
$new_text = "'Perl'";
@f = split /('.*?')/, $line;
# odd fields of @f contain regex matches
# even fields contain the text between matches
$f[2*$n-1] = $new_text;
$new_line = join '', @f;
...