Perl中如何跳过已积累匹配的正则重叠匹配？

原代码问题分析 #

你注释掉的条件逻辑失效，核心原因有三点：

1. 正则未加/g修饰符，手动设置pos($result)后无法生效，正则依然从字符串开头匹配；
2. /1{$len}/仅匹配连续的len个1，无法正确检测区间内混合0和1的情况；
3. 逻辑目标偏差：你需要检查「当前匹配的整个区间是否已全为1」，但原写法是检查「从pos位置开始是否有连续len个1」，两者不匹配。

修复方案 #

方案1：用正则+\G锚点实现无复制检查 #

利用\G锚定到手动设置的位置，直接检查目标区间是否全为1，无需复制子串：

修改后的完整代码：

#!/usr/bin/env perl

# 用户输入
my $regexp = "abc|cba|b";
my $string = "_abcbabc_bacba";

my $length = length($string);
my $result = "0" x $length;

while ( pos($string) < $length and $string =~ /$regexp/go ) {
    pos($string) = $-[0] + 1;
    next unless my $len = $+[0] - $-[0];

    # 修复后的检查逻辑：确认当前匹配区间未被完全覆盖
    pos($result) = $-[0];
    next if $result =~ /\G1{$len}/;

    substr($result, $-[0], $len) = "1" x $len;

    printf "%s\n", $string;
    printf "%" . $-[0] . "s%s\n", "", "^" x $len;
}
printf "%s\n", $result;

方案2：子串检查（简单直观，开销可忽略） #

如果不介意临时读取子串，也可以直接提取区间内容检查是否存在未标记的0：

# 替换原注释部分
my $existing = substr($result, $-[0], $len);
next if $existing !~ /0/; # 无0则全为1，跳过当前匹配

运行结果 #

执行修复后的代码，会得到你期望的输出：

_abcbabc_bacba
 ^^^
_abcbabc_bacba
   ^^^
_abcbabc_bacba
     ^^^
_abcbabc_bacba
         ^
_abcbabc_bacba
           ^^^
01111111010111

关键说明 #

• \G锚点：强制正则从pos()设置的位置开始匹配，确保只检查当前匹配对应的区间；
• 跳过逻辑：仅当区间内所有字符已被标记为1时，才跳过当前匹配，避免重复处理已覆盖的区域；
• 无复制实现：方案1通过正则直接操作原字符串的位置，无需复制子串，符合你的性能需求。

内容的提问来源于stack exchange，提问作者Fravadona