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

Question

Hi

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

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

Answer 2

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 3

This might be what you want:

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

Answer 4

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 5

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.

Answer 6

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.