On Sat, Sep 5, 2009 at 15:36, Martín Ferrari<martin.ferr...@gmail.com> wrote:
> $ perl -MPET::Watch -e '$r = shift; $s = shift;
> PET::Watch::safe_replace($s, $r); print "$s\n"' 's/()/./g' foo
> foo
This was a mistake, I didn't call the function properly. Raphael's
patch makes this loop forever!
$ time perl -MPET::Watch -e '$r = shift; $s = shift;
PET::Watch::safe_replace(\$s, $r); print "$s\n"' 's/()/./g' foo
^C
real 0m3.250s
user 0m3.116s
sys 0m0.040s
After a lot of reading, I found one solution to this:
$ perl -MPET::Watch -e '$r = shift; $s = shift;
PET::Watch::safe_replace(\$s, $r); print "$s\n"' 's/()/./g' foo
.f.o.o.
See the patch below, or refer to revision 748 of
svn://svn.debian.org/svn/pet/trunk/PET/Watch.pm
@@ -608,8 +608,6 @@
my $global = ($flags =~ s/g//);
$flags = "(?$flags)" if length $flags;
- my (@captures, $first, $last);
-
# Behave like Perl and treat e.g. "\." in replacement as "."
# We allow the case escape characters to remain and
# process them later
@@ -629,24 +627,35 @@
# the global flag was set on the input pattern.
my $orig_replacement = $replacement;
+ my ($first, $last, $pos, $matched, @captures) = (0, -1);
while (1) {
eval {
# handle errors due to unsafe constructs in $regexp
no re 'eval';
- my $re = qr/$flags$regexp/;
-
- @captures = ($$in =~ $re);
+ # restore position
+ pos($$in) = $pos if($pos);
+ if($last - $first == 0) {
+ # previous match was a zero-width match, simulate it to set
+ # the internal flag that avoids the infinite loop
+ $$in =~ /()/g;
+ }
+ # Need to use /g to make it use and save pos()
+ $matched = scalar($$in =~ /$flags$regexp/g);
+ # save position and size of the match
+ $pos = pos($$in);
($first, $last) = ($-[0], $+[0]);
+ for my $i (0..$#-) {
+ $captures[$i] = substr $$in, $-[0], $+[0] - $-[0];
+ }
};
return 0 if $@;
# No match; leave the original string untouched but return
# success as there was nothing wrong with the pattern
- return 1 if @captures == 0;
+ return 1 unless $matched;
# Replace $X
- unshift @captures, substr $$in, $first, $last - $first;
$replacement =~ s/[\$\\](\d)/defined $captures[$1] ?
$captures[$1] : ''/ge;
$replacement =~ s/\$\{(\d)\}/defined $captures[$1] ?
$captures[$1] : ''/ge;
$replacement =~ s/\$&/$captures[0]/g;
@@ -659,14 +668,12 @@
# Actually do the replacement
substr $$in, $first, $last - $first, $replacement;
+ # Update position
+ $pos += length($replacement)- ($last - $first);
- if ($global) {
+ last unless($global);
$replacement = $orig_replacement;
- } else {
- last;
}
- }
-
return 1;
}
}
--
Martín Ferrari
--
To UNSUBSCRIBE, email to debian-bugs-dist-requ...@lists.debian.org
with a subject of "unsubscribe". Trouble? Contact listmas...@lists.debian.org
