Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

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??

Description:

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;
}
Comment on Substitute (s///) a set of times
Download Code
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.)


      ---
      demerphq

        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"'.

Back to Snippets Section

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (18)
As of 2015-07-30 13:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (271 votes), past polls