How can I replace all the text before the match in a Perl substitution?

Question

I am reading each line of an input file (IN) and printing the line read to an output file (OUT) if the line begins with one of the patterns, say "ab", "cd","ef","gh","ij" etc. The line printed is of form "pattern: 100" or form "pattern: 100:200". I need to replace "pattern" with "myPattern", i.e. print the current line to FILE but replace all the text before the first occurence of ":" with "myPattern". What is the best way to do this?

Currently I have:

while ( <IN> )
{ 
    print FILE if /^ab:|^bc:|^ef:|^gh:/;
}

I am not sure if substr replacement would help as "pattern" can be either "ab" or"cd" or "ef" or "gh" etc.

Thanks! Bi

Answer 1

sub replacer {

    $line = shift;
    $find = shift;
    $replace = shift;

    $line =~ /([^:]+):/
    if ($1 =~ /$find/) { 
         $line =~ s/([^:]+):/$replace/ ;
         return $line;      
    }
    return ;

}

while (<IN>)
{
    print OUT replacer ($_,"mean","variance");
    print OUT replacer ($_,"pattern","newPattern");
}

My perl is a little rusty, so syntax might not be exact.

edit: Put it in a function for ya.

Answer 2

Generically, do this like:

my %subst = ( 'ab' => 'newab', 'bc' => 'newbc', 'xy' => 'newxy' );
my $regex = join( '|', map quotemeta, sort { length($b) <=> length($a) } keys %subst );
$regex = qr/^($regex):/;

while ( <IN> ) {
    print FILE if s/$regex/$subst{$1}:/;
}

The sort puts the longest ones first, so that if the data has ab:: and both ab and ab: are being substituted, ab: is used instead of ab.

Answer 3

Perl's substitution operator by default (a) uses the first match, (b) only replaces one match and (c) returns true if a replacement was made and false if it wasn't.

So:

while ( <IN> )
{ 
    if (s/<pattern1>:/<replace1>/ ||
        s/<pattern2>:/<replace2>/) {
       print FILE;
    }
}

Should work for you. Note that because of short-circuiting, only one substitution will be made.

Answer 4

while ( <IN> )
{ 
  s/^pattern:/myPattern:/;
  print OUT
}

Answer 5

This might be what you want:

$expr = "^(ab)|(cd)|(ef)|(gh)|(ij)";
while (<IN>)
{
    if (/$expr:/)
    {
        s/$expr/$myPattern/;
        print FILE;
    }
}

Answer 6

The shortest way to do what you ask above is to re-use your code, but include a substitution.

while ( <IN> )
{ 
    print FILE if s/^(ab|bc|ef|gh):/MyPattern:/;
}

Any of the left hand side patterns will be replaced. If the left hand side does not match, nothing will be printed.