> Yes, it's a tricky one. There's a couple of items in the TODO list
> which read:
>
> * Richard Tietjen's patch for stash replace. Allows back references
> (e.g. $1) but it would be nice to find a rock-solid way to implement
> it without relying on unusual ^A delimiter character.
>
> * Further to the above, Craig Barratt has this solution which will be
> going into the next verion (2.05b) unless anyone has any further
> suggestions to make before then.
>
> It would be great if replace handled backreferences. I don't like
> the ^A solution since the string could contain ^A, plus it is a
> security hole. The attempt I posted only works for up to 9
> backreferences and doesn't handle an escaped '\$' and uses nested
> evals:
>
> $str =~ s{$search}{
> my $r = $replace;
> my @d = (0, $1, $2, $3, $4, $5, $6, $7, $8, $9);
> $r =~ s/\$(\d+)/$d[$1]/eg;
> $r;
> }eg;
>
> I wish there was a perl predefined variable array containing all
> the backreferences (is there one?). You can avoid the hard-coded
> limit of 9 with extra evals, and a bit of work on the re could
> handle the escaped '\$' case, so maybe that would be good enough.
>
> I obviously didn't put it into 2.05b like I said I would (mea culpa)
> but I'm happy for it to go in now.
Even with Randal's reminder about m/// returning the backrefs, I
couldn't substantially improve my earlier suggestion for replace.
Here's an improved form of the replace sub that handles arbitrary
numbers of backrefs, correctly handles backslash escapes on '$'
(so that '\$1', '\\\$1', etc are not replaced, but '\\$1', '\\\\$1'
are), and supports options (i,g,s,m,x) through an extra optional
argument (default is "g" to remain backward compatible).
sub replaceBackrefs
{
my($replace) = @_;
my(@d);
# save array of backrefs, because regexp below destroys them
for ( my $i = 1 ; defined(my $v = eval("\$$i")) ; $i++ ) {
push(@d, $v);
}
# replace each $\d+ with backref, provided it is preceded by an
# even number # of backslashes, including 0
$replace =~ s{(\\*)\$(\d+)}{length($1) % 2 ? "$1\$$2" : "$1$d[$2-1]"}eg;
return $replace;
}
$Template::Stash::SCALAR_OPS->{replace} = sub replace {
my ($str, $search, $replace, $opts) = @_;
my ($global);
$replace = '' unless defined $replace;
return $str unless defined $str and defined $search;
$opts ||= 'g';
$global = 1 if ( $opts =~ s/g//g );
$opts = "(?$opts)" if ( $opts ne "" );
if ( $replace !~ /\$/ ) {
# do simple replace if there are no backrefs in $replace
if ( $global ) {
$str =~ s{$opts$search}{$replace}g;
} else {
$str =~ s{$opts$search}{$replace};
}
} else {
# do more expensive eval replacement for backrefs
if ( $global ) {
$str =~ s{$opts$search}{replaceBackrefs($replace)}eg;
} else {
$str =~ s{$opts$search}{replaceBackrefs($replace)}e;
}
}
return $str;
};
Please send suggestions for something cleaner or more compact. If there
are no objections or improvements I can try comitting it (Andy gasps).
Craig
