HKS has asked for the wisdom of the Perl Monks concerning the following question:

Hello all,

As you may have guessed from the title, I'm trying to slurp in search-replace patterns from a file. For instance, patterns.txt contains:

s/foo/bar/
s/(fo)o/bar$1/

[download]

The first one is easy:

my $pattern = <FILE>;
my @parts = split /\//, $pattern;
my $search = qr/$parts[1]/;
$string =~ s/$search/$parts[2]/;

[download]

But when backreferences are introduced into the replace portion, things get complicated: the $1 is pulled in as a literal string. Is there any way to enable its interpolation once it's inside the s/// pattern, or another way of accomplishing the same goal?

Thanks in advance for any help.

-HKS

Replies are listed 'Best First'.
Re: Slurping search-replace patterns from a file
by jettero (Monsignor) on Oct 14, 2008 at 15:13 UTC
    ... patterns.txt contains: 
    s/foo/bar/
s/(fo)o/bar$1/

    [download]

    Because your input file appears to contain perl code, I suspect you can get by with eval: 

    while(my $line = <FILE>) {
    chomp;
    eval "\$string =~ $line; 1" or die $@;
}

    [download]

    -Paul

[reply]
[d/l]
[select]
      Because your input file appears to contain perl code, I suspect you can get by with eval:

      Unfortunately, it's not quite that simple. I provided an overly simplified example - it's usually not that clean. This is more along the lines of what my file looks like:

      replace {
(foo) and stuff
} with {
bar $1
}

      [download]

      Which will be programmatically consolidated to:

      s/(foo) and stuff/bar $1/

      I'd like to avoid debating the format, which is why I provided the simplified example.

      All the same, thanks for pointing out that an eval would work in the original situation.

      -HKS

[reply]
[d/l]
[select]
        Eval may still be the way to go though... 
        # rip stuff from file
eval "$wahtever =~ s/$lhs/$rhs/; 1" or die $@;

        [download]
        The /ee stuff is essentially the same as that (in the sense that it has to run eval() on the rhs... I fail to see how you'll preserve the meaning of $1 without an eval or /ee.

        -Paul

[reply]
[d/l]
Re: Slurping search-replace patterns from a file
by binf-jw (Monk) on Oct 14, 2008 at 15:13 UTC
    just add the /e modifier.
    $string =~ s/$search/$parts[2]/e;
    Update:
    As for the $1 being pulled as a literal string, more info is needed. Could be you're trying to use it like this:
    s/(.{60})/$1/g which works fine..
    if you need it in the same expression use a back reference \1:
    perlretut: /\b(\w\w\w)\s\1\b/;
    Update: Miss understood what you were trying to do, recently had to get a sub routine call in a s/// sorry. John
[reply]
[d/l]
[select]
      With just one /e modifier, you keep the $1. A trivial test would have shown that: 
      $ perl -wE '$r = q{bar$1}; $_ = "foo"; s/(fo)o/$r/e; say'
bar$1

      [download]
[reply]
[d/l]
Re: Slurping search-replace patterns from a file
by JavaFan (Canon) on Oct 14, 2008 at 15:16 UTC 
    use strict;
use warnings;

while (<DATA>) {
    chomp;
    my ($pat, $repl) = (split '/') [1, 2];
    my $s = "foo";
    $s =~ s/$pat/qq{"$repl"}/ee;
    say $s;
}

__DATA__
s/foo/bar/
s/(fo)o/bar$1/

    [download]
    This prints: 
    bar
barfo

    [download]
[reply]
[d/l]
[select]
      Please don't recommend something like that without mentioning that the /ee modifier calls eval and thus opens the door for execution of arbitrary code.

      A safe alternative might be String::Interpolate, but it might require a bit more work.

      Update: if it's not obvious what the unsafe part is, look at this: 

      my $x = 'abc';

my $evil = '"; print "evil stuff here\n"; "';
$x =~s/a(bc)/qq{"$evil"}/ee;

      [download]

      Instead of the print... arbitrary perl code can be executed.

[reply]
[d/l]
[select]

        Since the issue is the interpolation of the replacement string, can you not stamp on '$' and '@', leaving only '$1' et al ? That is:

        use strict ;
use warnings ;

while (<DATA>) {
    my ($pat, $repl) = (split '/') [1, 2];
    # Escape $ and @ preceded by an even number of '\', except for $1 
+etc.
    $repl =~ s/(?<!\\)((?:\\\\)*(?:\$(?!\d)|\@))/\\$1/g ;
    my $e = "\$s =~ s/$pat/$repl/" ;

    my $s = "foo";
    print "$e  '$s' -> " ;

    eval $e ; die $@ if $@ ;
    print "'$s'\n" ;
}

__DATA__
s/foo/bar/
s/(fo)o/bar$1/
s/oo/\${system "echo hello sailor !"}/
s/oo/\\${system "echo hello sailor !"}/
s/oo/\\\${system "echo hello sailor !"}/
s/oo/\\\\${system "echo hello sailor !"}/
s/oo/\\\\\${system "echo hello sailor !"}/
s/oo/@{system "echo hello sailor !"}/
s/oo/\@{system "echo hello sailor !"}/
s/oo/\\@{system "echo hello sailor !"}/

        [download]
        Noting that you don't want to "activate" '\$' or '\@' by inserting '\'.

        Hope I didn't miss anything...

[reply]
[d/l]

      Unfortunately, this is rather fragile - if "$repl" contains, say, a double quote, it breaks. My solution is somewhat similar, but it uses an actual "eval" so I can catch/warn about the errors: 

      #!/usr/bin/perl -w
use strict;

while (<DATA>) {
    next unless /^\s*s\//;    # Minimal checking
    chomp;
    my ($pat, $repl) = (split '/') [1, 2];
    my $s = "foo";
    eval "\$s =~ s/$pat/$repl/";
    warn "Warning: $@" if $@;
    print "$s\n";
}

__DATA__
s/foo/bar/
s/(fo)o/bar$1/

      [download]

      --
      "Language shapes the way we think, and determines what we can think about."
      -- B. L. Whorf
[reply]
[d/l]
        ... and is just as vulnerable to code injection as the original solution. Add this line to the __DATA__ section: 
        s/./${system "echo foo"}/

        [download]
        Or instead of echo foo you can write rm -rf ~/* - I think you get the idea pretty quickly.
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom