Perl qr// and substitution

user107498 picture user107498 · Aug 3, 2009 · Viewed 10k times · Source

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

FMc picture FMc · Aug 3, 2009

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...";
}