Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Selective substitution: not in Perl?

by Anonymous Monk
on Aug 16, 2000 at 13:19 UTC ( #28079=perlquestion: print w/ replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

<html>

Hi, while I was trying to convert some old sed programs which use the /n flag (substitute match n and nothing else) of the s/// operator to Perl, I was very disappointed when I discovered Perl does not support this flag. a2p/s2p do not either:


$ echo foofoofoofoo | sed 's/foo/bar/2'
foobarfoofoo
$ echo 's/foo/bar/2' | s2p
Unrecognized substitution command(2) at line 1
$ echo foofoofoofoo | awk '{print gensub(/foo/, "bar", 2)}'
foobarfoofoo
(as far as I know gensub() is only supported by GNU awk)
$ echo '{print gensub(/foo/, "bar", 2)}' | a2p
syntax error in file - at line 1
Translation aborted due to syntax errors

This code works:

@foos = split(/(?=foo)/, 'foo' x 4); $foos[1] = 'bar'; undef $_; for $elem(@foos) { $_ .= $elem; } print;
And this does too:
$_ = 'foo' x 4; for(map { ++$i == 2 ? 'bar' : $_ } split(/(?=foo/, $_)) { $result .= $_; } print $result;
but it's a bit too ugly for me, especially when used multiple times. Is the ability to substitute a specific match with a simple flag only found in the Land of Sed and Awk? I'm kind of suprised something as trivial as substituting an arbitrary match is simpler in sed and awk than Perl. Is there any reason selective substitution via flags was left out of Perl, or is this just an oversight? Or am I missing something obvious?

- A Shocked sed Addict

Comment on Selective substitution: not in Perl?
Select or Download Code
RE: Selective substitution: not in Perl?
by atl (Pilgrim) on Aug 16, 2000 at 14:25 UTC
    Hi,

    a quick hack to solve your problem:

    #!/usr/bin/perl -w use strict; my $string = "foo" x 4; print "$string\n"; my $pattern = "foo"; my $better = "bar"; my $n=1; $string =~ s/^(($pattern){$n})$pattern/$1$better/; print "$string\n";
    $n holds the number of occurences to be skipped, so $n = 1 means the second will be replaced. The output:

    atl@companion:~/perl/s > one.pl foofoofoofoo foobarfoofoo
    I believe that's what you wanted. IMHO it ain't ugly, too. ;-)

    Have fun ...

    Andreas

      I was going to give a similar solution, but then I realised that the previous (non-replaced) matches didn't necessarily have to be consecutive in the original string. Perhaps you you need to put optional separator space in the regex. Something like...

      $string =~ s/^(($pattern.*){$n})$pattern/$1$better/;
      --
      <http://www.dave.org.uk>

      European Perl Conference - Sept 22/24 2000, ICA, London
      <http://www.yapc.org/Europe/>
        The .* is greedy, as far as I can see that will always replace ithe last match if you have more than the number you need.
        my string = "foo_a_foo_b_foo_c_foo_d_foo_e_foo_f_foo" my $pattern = "foo" my $better = "bar" my $n = 1; $string =~ s/^(($pattern.*){$n})$pattern/$1$better/;
        would give:
        "foo_a_foo_b_foo_c_foo_d_foo_e_foo_f_bar"
        not
        "foo_a_bar_b_foo_c_foo_d_foo_e_foo_f_foo"

        Nuance

      That doesn't work, suppose I have the string "abacab" and want to replace the second a with an upper case A. Your regex doesn't match. How about this (untested):
      #!/usr/bin/perl -w use strict; my $string = "abacab"; print "$string\n"; my $pattern = "a"; my $better = "A"; my $n=1; my $i=0; $string =~ s/($pattern)/$i == $n ? $better : $1; i++/ge; print "$string\n"

      Nuance

        Black magic! I'm really impressed, I didn' know you can put that all into the substitution pattern. /me bows to Nuance ...

        As for my solution, I was focused on the sample input given, I didn't think of the more general problem. But you're right about this.

        As for your script, it works with a small alteration:

        $string =~ s/($pattern)/$i++ == $n ? $better : $1/ge;
        If you increment $i in a seperate statement, the whole block evaluates to the value of $i und you get
        abacab 0b1c2b
        Ok, now we're having fun :-)...

        Andreas (waiting for the chinese food delivery service ...)

        Thanks, your solution works great! I wrote a sub to convert sed-ish s///n constructs to your format, making conversion from sed easier:
        sub seval { my ($sub) = shift; $vni++; $sub =~ s#s/([^/]+)/([^/]+)/(.+)#s/\1/\$i$vni++ == \3 ? \2 : \$&/e +gs#; return $sub; } # Evals 's/foo/$i1++ == 1 ? bar : $&/egs' eval(seval("s/foo/bar/2"));
        Thanks again.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (13)
As of 2014-11-26 15:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (171 votes), past polls