in reply to Regex stored in a scalar

I wanted to do something similar to this recently, but with the left and right-hand patterns stored in a database. The problem I ran into, however, was if I tried to use capture variables, such as the following (contrived) example: 

perl -Mstrict -Mwarnings -le '
my $c = q{asdfghjk}; 
my @regex = ( 
    { lh => q{(gh)}, rh => q{__$1__}, }, 
    { lh => q{(h_)}, rh => q{_h!$1!}, }, 
);
print q{Original: }, $c;
foreach my $i ( 0 .. $#regex ) {
    $c =~ s/$regex[$i]{lh}/$regex[$i]{rh}/gmsx;
}
print q{Final: }, $c;
'

[download]

Output, expected: 

Original: asdfghjk
Final: asdf__g_h!h_!__jk

[download]

Output, actual: 

Original: asdfghjk
Final: asdf__$1__jk

[download]

If the value for the rh key is changed to use the qq operator, then "uninitialized value $1 in concatenation" messages appears, and the final string becomes 'asdf____jk'.

Any suggestions?

Replies are listed 'Best First'.
Re^2: Regex stored in a scalar
by Athanasius (Archbishop) on Aug 22, 2015 at 07:41 UTC

    Hello atcroft,

    The only way I can find to do this is to pull the substitution apart into its component steps and perform these separately:

    #! perl
use strict;
use warnings;

my $c = q{asdfghjk};

my @regex =
(
    { lh => q{(gh)}, rh => q{__$1__}, }, 
    { lh => q{(h_)}, rh => q{_h!$1!}, }, 
);

print q{Original: }, $c, "\n";

for my $i (0 .. $#regex)
{
    if ($c =~ /$regex[$i]{lh}/)
    {
        my $s =  $1;
        my $d =  $regex[$i]{rh};
           $d =~ s/\$1/$s/;
           $c =~ s/$regex[$i]{lh}/$d/;
    }
}

print q{Final: }, $c, "\n";

    [download]

    Output:

    17:37 >perl 1352_SoPW.pl
Original: asdfghjk
Final: asdf__g_h!h_!_jk

17:39 >

    [download]

    This is far from elegant, and I keep thinking there must be a simpler way involving s///ee — but I haven’t found it.

    Anyway, hope that helps,

    Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

[reply]
[d/l]
[select]

      One way to one step per regex: 

      c:\@Work\Perl>perl -wMstrict -le
"my $c = q{asdfghjk};
 print qq{    original: '$c'};
 ;;
 my @regex = (
   { lh => q{(gh)}, rh => q{__$1__}, },
   { lh => q{(h_)}, rh => q{_h!$1!}, },
   );
 ;;
 for my $hr_s (@regex) {
   $c =~ s[ (?-x)$hr_s->{lh}]{ qq{qq{$hr_s->{rh}}} }xmsgee;
   print qq{intermediate: '$c'};
   }
 ;;
 print qq{       final: '$c'};
"
    original: 'asdfghjk'
intermediate: 'asdf__gh__jk'
intermediate: 'asdf__g_h!h_!_jk'
       final: 'asdf__g_h!h_!_jk'

      [download]
      Since  s///e or  s///ee is string eval, AnonyMonk's warning/advice here still holds. See Re: Evaluating $1 construct in literal replacement expression and associated nodes for more discussion.

      Give a man a fish:  <%-{-{-{-<

[reply]
[d/l]
[select]
Re^2: Regex stored in a scalar ( s///eeval )
by Anonymous Monk on Aug 22, 2015 at 09:22 UTC 
    $_ = 'foo';
$left  = '(.)(.)';
$right = '$1$2$2$1';
s{$left}{"qq{$right}"}ee;
print "$_\n";
s{$left}{eval "qq{$right}"}e;
print "$_\n";
__END__
foofo
foofofo

    [download]

    first /e turns "" into a string qq{$1$2$2$1}

    second /e interpolates qq{$1$2$2$1} at the correct time and substitutes into the original string

    string eval is eval so arbitrary code could be executed

    So, to make it safer, instead of eval ... use some form of String::Interpolate/String::Interpolate::RE

[reply]
[d/l]

      Thanks Anonymous Monk and AnomalousMonk,

      So, the technique is to doubly double-stringify the RHS before doubly evaluating it! Analogous to the trick of using @{ [...] } to interpolate a function-returned list into a string.

      I like String::Interpolate (the module, not its documentation!):

      #! perl
use strict;
use warnings;
use String::Interpolate qw( interpolate );

my $c = q{asdfghjk};

my @regex =
(
    { lh => q{(gh)}, rh => q{__$1__}, }, 
    { lh => q{(h_)}, rh => q{_h!$1!}, }, 
);

print q{Original: }, $c, "\n";

for my $i (0 .. $#regex)
{
    $c =~ s/ $regex[$i]{lh} / interpolate($regex[$i]{rh}) /ex;
}

print q{Final: }, $c, "\n";

      [download]

      Output:

      13:37 >perl 1352_SoPW.pl
Original: asdfghjk
Final: asdf__g_h!h_!_jk

13:37 >

      [download]

      Cheers,

      Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom