Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

perl: passing subroutines rexexp replace with search results

i have the following perl subroutine:

sub rep {

 defined ($filein = shift) || die ("no filein");
 defined ($fileout = shift) || die ("no fileout");
 $look = shift;
 $replace = shift;
 open (infile, "$filein")|| die;
 open (outfile, "> $fileout")|| die;
 while (<infile>) {
   s/$look/$replace/g;
   print outfile;
 }
(close the files)
}

and the following text:

kuku(fred) foo(3)
kuku(barney) foo(198)

i want to call it with the following structures:

$look = kuku\((\w+)\) foo \((\d+)\),
$replace = gaga\(($1)\) bar\(($2)\).

but when i called the sub with the following (and it's variations), i couldn't make it accept the $1, $2 format:

&rep ($ARGV[0], $ARGV[1], 
    "kuku\\(\(\\w+\)\\) foo \\(\(\\d+\)\\)" , 
    "gaga\\(\(\$1\)\\) bar\\(\(\$2\)\\)");

all i get is:

gaga($1) bar($2)
gaga($1) bar($2)

what am i doing wrong? how can i make the subroutine identify the $1\ $2 (...) as the search results of the search and replace?

like image 524
user2141046 Avatar asked Mar 24 '23 17:03

user2141046


1 Answers

I'm not sure if substitution part in regex can be set in a way you want it without using eval /e, so this is how I would write this.

qr// parameter is real regex, followed by callback in which $_[0] is $1

rep( $ARGV[0], $ARGV[1], qr/kuku\((\w+)\) foo \((\d+)\)/, sub { "gaga($_[0]) bar($_[1])" } );

sub rep {

  my ($filein, $fileout, $look, $replace) = @_;
  defined $filein or die "no filein";
  defined $fileout or die "no fileout";

  open (my $infile, "<", $filein) or die $!;
  open (my $outfile, ">", $fileout) or die $!;

  while (<$infile>) {
    s/$look/$replace->($1,$2)/ge;
    print $outfile;
  }
  # (close the files)
}

This could be even more simplified by just passing callback which would change $_.

rep( $ARGV[0], $ARGV[1], sub { s|kuku\((\w+)\) foo \((\d+)\)|gaga($1) bar($2)| } );

sub rep {

  my ($filein, $fileout, $replace) = @_;
  defined $filein or die "no filein";
  defined $fileout or die "no fileout";

  open (my $infile, "<", $filein) or die $!;
  open (my $outfile, ">", $fileout) or die $!;

  while (<$infile>) {
    $replace->();
    print $outfile;
  }
  # (close the files)
}
like image 154
mpapec Avatar answered Apr 13 '23 05:04

mpapec