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

What I want to do

I have a set of substitutions where both the pattern and the replacements are read from a config file at run time. Handling the patterns with qr// is no sweat, but the replacements pose more of a challenge, specifically in dealing with capture variables ($1 and friends).

What I've tried

use strict;
use warnings;


my $repl = '$1';
{ 
    print "attempt 1 ";
    my $str = "a,A,c,d";
    $str =~ s/([a-z]),/$repl/ig;
    print "yields: $str\n";
}

{ 
    no strict 'refs';
    print "attempt 2 ";
    my $str = "a,A,c,d";
    $str =~ s/([a-z]),/$$repl/ig;
    print "yields: $str\n";
}

{ 
    print "attempt 3 ";
    my $str = "a,A,c,d";
    $str =~ s/([a-z]),/eval "$repl"/ieg;
    print "yields: $str\n";
}


my $code = 'sub {$_[0] =~ s/([a-z]),/'. $repl . '/ig}';
my $re = eval ($code);
if ($@) { print "eval failed: $@" }
{ 
    print "attempt 4 ";
    my $str = "a,A,c,d";
    $re->($str);
    print "yields: $str\n";
}

__END__

attempt 1 yields: $1$1$1d
Use of uninitialized value in substitution (s///) at zwomp.pl line 17.
attempt 2 yields: d
attempt 3 yields: aAcd
attempt 4 yields: aAcd

[download]
Attempts 3 and 4 work correctly. 3 is useless to me because this will be in a long running loop, and my goal is to expunge string evals from the loop. 4 is passable, since the eval can be done outside of the loop. That being said, 2 looks like it should work, or could be made to work, but I can't get it to. The uninitialized value warning leads me to think it's grabbing $1 from outside the s//, but I'm not really sure how to correct for this. Does anyone have any advice, or any other thoughts on ways to approach this problem?

For the curious, why I'm doing this

I'm building a text transformation engine, not entirely unlike a very simple parser (much too simple for Parse::RecDescent to be helpful). In essence, it has a collection of transformations which it applies to named input "tokens" to get named output "tokens". For example, it might have a rule to the effect of
URL: 
    domain: 
        match: http://(\w+)\.(\w+)\.
        replace: $2

[download]
which should be read (in some kind of pseudo-code) as:
apply s/http://(\w+)\.(\w+)\./$2/ to 'URL' to produce 'domain'

[download]
The transformations themselves come out of a config file because several different languages need to implement a consistent set of transformations. This way, as long as each language has a reliable way of reading the input file and generating translation rules, and changes to the rules are made only in the config file, new rules or modifications will be applied in all places automatically. The goal is to prevent inconsistency between the different (language) translation processes.

Any thoughts on this would be greatly appreciated.

Replies are listed 'Best First'.
Re: Dynamically generating the replacement part of a substitution
by CountZero (Bishop) on Oct 06, 2008 at 20:25 UTC 
    $str =~ s/([a-z]),/$repl/eeig;

    [download]
    seems to do exactly what you require.

    Output: 

    attempt 1 yields: aAcd

    [download]

    CountZero

    A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

[reply]
[d/l]
[select]
Re: Dynamically generating the replacement part of a substitution
by JavaFan (Canon) on Oct 06, 2008 at 17:41 UTC
    Looks like all of your attempts are broken. I'd expect the resulting string to be aA,cd, and not to lose all its commas.

    I'd go for a variant of attempt 3: 

        my $repl = '$1';
    my $str = "a,A,c,d";
    s/([a-z]),/$repl/eeg;  # Note the double 'e' modifier
    say $str;
    __END__
    aA,cd

    [download]
    No need to turn off strictness.

    Now, if you don't want string evals in the loop, I presume you want that because of performance. But you replace that with a subroutine call - I'd have to see a benchmark to be certain that is faster.

    But what you could do is (string) eval your entire loop: 

        my $repl = '$1';
    eval <<"EOT";
        while (1) {
            \$str =~ s/([a-z]),/$repl/g;
        }
    EOT

    [download]
[reply]
[d/l]
[select]
Re: Dynamically generating the replacement part of a substitution
by Jenda (Abbot) on Oct 06, 2008 at 17:41 UTC

    The attempt number three is still invalid. Try it with my $repl = '$1-$1-'; The attempt four fails if the replacement contains a doublequote.

    #my $repl = '$1-$1-';
use strict;
use warnings;


#my $repl = '$1';
my $repl = '$1"{$1-';
{
    print "attempt 1 ";
    my $str = "a,A,c,d";
    $str =~ s/([a-z]),/$repl/ig;
    print "yields: $str\n";
}

{
    no strict 'refs';
    print "attempt 2 ";
    my $str = "a,A,c,d";
    $str =~ s/([a-z]),/$$repl/ig;
    print "yields: $str\n";
}

{
    print "attempt 3 ";
    my $str = "a,A,c,d";
    $str =~ s/([a-z]),/eval "$repl"/ieg;
    print "yields: $str\n";
}


my $code = 'sub {$_[0] =~ s/([a-z]),/'. $repl . '/ig}';
my $re = eval ($code);
if ($@) { print "attempt 4 failed: $@" }
else {
    print "attempt 4 ";
    my $str = "a,A,c,d";
    $re->($str);
    print "yields: $str\n";
}

{
    print "attempt 5 ";
    (my $repl = $repl) =~ s/"/\\"/g;
    my $str = "a,A,c,d";
    $str =~ s/([a-z]),/qq{"$repl"}/igee;
    print "yields: $str\n";
}

    [download]

    Jenda
    Support Denmark!
    Defend the free world!

[reply]
[d/l]
[select]
Re: Dynamically generating the replacement part of a substitution
by moritz (Cardinal) on Oct 06, 2008 at 17:03 UTC
[reply]
Re: Dynamically generating the replacement part of a substitution
by Andrew Coolman (Hermit) on Oct 06, 2008 at 17:22 UTC
    This might work. 
    my $repl = '1';
{ 
    no strict 'refs';
    print "attempt 2 ";
    my $str = "a,A,c,d";
    $str =~ s/([a-z]),/${$repl}/ig;
    print "yields: $str\n";
}
__END__
attempt 2 yields: aAcd

    [download]

    Regards,
    s++ą  ł˝ ął. Ş ş şą Żľ ľą˛ş ą ŻĽąş.}++y~-~?-{~/s**$_*ee
[reply]
[d/l]
Re: Dynamically generating the replacement part of a substitution
by leocharre (Priest) on Oct 06, 2008 at 17:43 UTC
    This may be of value here, although it does not directly address your question. 
    my %CHANGE = (
':-)' => 'happy',
':-(' => 'sad',
);

my $text = "I am :-) but sometimes I am :-(.";

for my $out ( keys %CHANGE ){
   my $in = $CHANGE{$out};
   $text=~s/\Q$out\E/$in/sg; # need to use \Q \E for quoting
   # $text=~s/$out/$in/sg; # <- this will go bonkers, it will 
   # treat $out as a regex, not a string
}

print $text;
# output: I am happy but sometimes I am sad.

    [download]
[reply]
[d/l]
Re: Dynamically generating the replacement part of a substitution
by AnomalousMonk (Archbishop) on Oct 06, 2008 at 23:13 UTC
[reply]
Re: Dynamically generating the replacement part of a substitution
by MadCat (Initiate) on Oct 09, 2008 at 05:18 UTC
    If you're doing this in ways where a given input token needs to broken up into one (or more) output tokens, why not do simple matching or splitting? i.e. 
    my @captures = ($input_token =~ /$regex/);

    [download]
    Since you know the bits you want to replace already, it'd become something akin to: 
    my $repl_index = 1;
{ 
    print "attempt 1 ";
    my $str = "http://www.domain.com/";
    my $regex = qr|http://(.*)\.(.*)\.(.*)|;
    my @captures = ($str =~ /$regex/i);
    print "yields: ", $captures[$repl_index], "\n";
}

    [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom