问题
I want to find all occurences of "BBB" in a string and substitute them with "D". For example, I have "ABBBBC" and want to produce "ADBC" and "ABDC". (First substitute the first BBB, and then substitute the other BBB). Is there a nice way to do this in Perl?
$str = "ABBBBC";
for ( $str =~ m/B(?=BB)/g ) {
# I match both the BBBs here, but how to substitute the relevant part?
}
I want to get this array: ('ADBC', 'ABDC'), which comes from changing either of the BBBs to a D. The string "ABBBBBC" would give me "ADBBC", "ABDBC" and "ABBDC".
回答1:
To get overlapping matches, you have to play around with Perl's pos operator.
pos SCALARpos
Returns the offset of where the lastm//gsearch left off for the variable in question ($_is used when the variable is not specified). Note that 0 is a valid match offset. undef indicates that the search position is reset (usually due to match failure, but can also be because no match has yet been run on the scalar).
posdirectly accesses the location used by the regexp engine to store the offset, so assigning to pos will change that offset, and so will also influence the\Gzero-width assertion in regular expressions. Both of these effects take place for the next match, so you can't affect the position withposduring the current match, such as in(?{pos() = 5})ors//pos() = 5/e.Setting
posalso resets the matched with zero-length flag, described under Repeated Patterns Matching a Zero-length Substring in perlre.Because a failed
m//gcmatch doesn't reset the offset, the return fromposwon't change either in this case. See perlre and perlop.
For example:
#! /usr/bin/env perl
use strict;
use warnings;
my $str = "ABBBBC";
my @replaced;
while ($str =~ m/^(.*)\G(.+?)BBB(.*)$/g ) {
push @replaced, $1 . $2 . "D" . $3;
pos($str) = length($1) + 1;
}
print "[", join("][" => @replaced), "]\n";
Output:
$ ./prog [ADBC][ABDC]
回答2:
local our @replaced;
'ABBBBC' =~ /^(.*)BBB(.*)\z(?{ push @replaced, $1.'D'.$2 })(?!)/s;
来源:https://stackoverflow.com/questions/6572189/how-do-i-substitute-overlapping-matches-with-a-perl-regex