Perl qr// and substitution.

Question

Hi guys. I'm writing a tiny program that takes user input using Getops, and based on it, the program will either try to match a pattern against some text, or substitute text for what matched.

The problem I'm having is that I can't get the substitution portion to work. I'm looking at the qr// entry in the man pages: http://perldoc.perl.org/perlop.html#Regexp-Quote-Like-Operators but I'm not having any luck with it. I tried to model my code exactly like the docs in this case. I compile a match pattern, and substitute that into a substitution.

Could someone point out where I'm going wrong? (Don't worry about security too much, this is only a little script for personal use)

Here's what I'm looking at:

if($options{r}){

    my $pattern = $options{r};
    print "\nEnter Replacement text: ";
    my $rep_text = <STDIN>;

    #variable grab, add flags to pattern if they exist.
    $pattern .= 'g' if $options{g};
    $pattern .= 'i' if $options{i};
    $pattern .= 's' if $options{s};


    #compile that stuff
    my $compd_pattern = qr"$pattern" or die $@;
    print $compd_pattern; #debugging

    print "Please enter the text you wish to run the pattern on: ";
    my $text = <STDIN>;
    chomp $text; 

    #do work and display
    if($text =~ s/$compd_pattern/$rep_text/){ #if the text matched or whatever
     print $text;
    }
    else{
     print "$compd_pattern on \n\t{$text} Failed. ";
    }
} #end R FLAG

When I run it with -r "/matt/" -i, and enter the replacement text 'matthew', on the text 'matt', it fails. Why is this?

EDIT:

Thanks for the answers guys ! That was really very helpful. I combined both of your suggestions into a working solution to the problem. I have to handle the /g flag a little differently. Here is the working sample:

if($options{r}){

    my $pattern = $options{r};
    print "\nEnter Replacement text: ";
    my $rep_text = <STDIN>;
    chomp $rep_text;

    #variable grab, add flags to pattern if they exist.

    my $pattern_flags .= 'i' if $options{i};
    $pattern_flags .= 's' if $options{s};

    print "Please enter the text you wish to run the pattern on: ";
    my $text = <STDIN>;
    chomp $text; 

    #do work and display
    if($options{g}){
     if($text =~ s/(?$pattern_flags:$pattern)/$rep_text/g){ #if the text matched or whatever (with the g flag)
      print $text;
     }
     else{
      print "$pattern on \n\t{$text} Failed. ";
     }
    }
    else{
     if($text =~ s/(?$pattern_flags:$pattern)/$rep_text/){ #if the text matched or whatever
      print $text;
     }
     else{
      print "$pattern on \n\t{$text} Failed. ";
     }
    }
} #end R FLAG

Answer 1

Run it with -r "matt", not -r "/matt/". You don't need to, and in fact can't, supply pattern delimiters in your option string. The quotes are the delimiters in your qr. So it's actually looking for matt with slashes around it, the way you're running it, which isn't what you want. You're trying to use the quotes to tell Perl to treat your pattern string like it were source code, but unfortunately you can't do that.

All those pattern appends you're doing for the other options also won't work. You'll need to change the way you compile the regex if you want to do all that. Something like this might do it for /i and /s:

my $compd_pattern = qr/$pattern/ or die $@;
$compd_pattern = qr/$compd_pattern/i if $options{i};
$compd_pattern = qr/$compd_pattern/s if $options{s};

For /g you'll need to support an alternate version of the search/replace. /g isn't a valid modifier to qr//.

Answer 2

As chaos points out, you will encounter some difficulties using qr//. Do you really need to precompile the pattern? If not, a strategy like this might work:

my $pattern      = 'matt';
my $text         = 'Matt';
my $rep_text     = 'Matthew';
my $pattern_opts = 'i';

print $text, "\n" if $text =~ s/(?$pattern_opts:$pattern)/$rep_text/;

Update in response to your new code: you might consider using an approach like this:

my ($orig, $patt, $rep, $flags) = qw(FooFooFoo foo bar ig);

my $make_replacement = $flags =~ s/g//        ?
    sub { $_[0] =~ s/(?$flags:$patt)/$rep/g } :
    sub { $_[0] =~ s/(?$flags:$patt)/$rep/  }
;

if ( $make_replacement->($orig) ){
    print $orig;
}
else {
    print "Failed...";
}