Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

Substitute (s///) a set of times

by jryan (Vicar)
on Sep 03, 2004 at 22:14 UTC ( #388430=snippet: print w/replies, xml ) Need Help??

This subroutine will s/// a set number of times.

The obvious solution would seem to be: s/\Gpattern/blah/ while $count--, but that does not work because \G only works with m//, and s/(a)/<$1$1>/ while $count-- would restart the match each time at the beginning. (pos=0)

Usage is: subtimes($string, $number_of_times, $pattern, $string_to_substitute). You can include $dollar variables in $string_to_substitute, just make sure to remember to backslash the dollar variable in the string.

For instance, this: print subtimes("ababa", 2, qr/(a)/,"<\$1\$1>"); would print "<aa>b<aa>ba".

Update: Fixed a bug.

print subtimes($string, 2, qr/(a)/,"<\$1\$1>");

sub subtimes {
    my ($string, $count, $find, $tosub) = @_;
    no strict "refs";
    my $newstring;
    while ($count--) {
        next unless $string =~ /($find)/;
        my ($num,%res) = 2;
        $res{$num++}=$$num while defined $$num;
        my ($matched, $startoffset, $endoffset, $temp) = ($1, $-[0], $
++[0], $tosub);

        $temp =~ s/\$(\d+)/my $r=$1;$r++;$res{$r}/ge;
        $newstring .= substr($string, 0, $startoffset).$temp;
        substr($string, 0, $endoffset) = '';
    return $newstring.$string;
Replies are listed 'Best First'.
Re: Substitute (s///) a set of times
by runrig (Abbot) on Sep 04, 2004 at 01:02 UTC
    This is not very well tested, but how about:
    use re 'eval'; my $str = "111111111"; my $times = 5; my $re = qr/1/; my $cnt; $str =~ s/$re(?(?{++$cnt > $times})\A)/2/g; print "$str\n";
    Turning this into a subroutine is left as an exercise.

      IMO its a bad habit to use lexicals in such constructs. They will only work once. For instance your code will not work properly if naively converted to a subroutine. The $cnt var needs to be a package scoped var. Otherwise what happens is that the regex is compiled once and the first $cnt will be enclosed into the (?{}), on the second run the new $cnt is not used, rather the original will be used. So for instance

      use re 'eval'; sub limited_re { my $str=shift; my $re=shift; my $repl=shift; my $times=shift; our $cnt; local $cnt=0; $str =~ s/$re(?(?{++$cnt > $times})\A)/eval $repl/ge; print "$str\n"; } limited_re("111111111",qr/1/,5,2); limited_re("000000000111111111",qr/1/,2,5);

      Works as expected. Change the our $cnt; local $cnt=0; to a my $cnt; and it won't. I got bitten by this when working on a solution for QOTW 23 (which happens to be on my pad at the time of posting this.)


        First they ignore you, then they laugh at you, then they fight you, then you win.
        -- Gandhi

        Thanks, I did not realize the dangers of lexicals in this situation. Though in order to get the capture variable behavior of the OP's code, I made the following changes:
        ... $str =~ s/$re(?(?{++$cnt > $times})\A)/qq["$repl"]/gee; ... limited_re("111111111",qr/(1)/,'${1}5',2);
        Though it would have worked with the code as it was if you included double quotes inside the single quotes of the replacement string, e.g., '"${1}5"'.
Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: snippet [id://388430]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (4)
As of 2021-10-15 23:38 GMT
Find Nodes?
    Voting Booth?
    My first memorable Perl project was:

    Results (69 votes). Check out past polls.