Perl: Find and replace specific string in multiple

Question

I need to get all the .config file in a given directory and in each of these file I need to search for a specific string and replace with another based on the file.

For e.g if I have 3 file in the given directory:

 for  my_foo.config - string to search "fooCommon >" replace with "~ /fooCommon[\/ >"
 for  my_bar.config - string to search "barCommon >" replace with "~ /barCommon[\/ >"
 for  my_file.config - string to search "someCommon >" replace with "~ /someCommon[\/ >"

Please let me know how this can be done in Perl?

Below is the code that I tried in shell scripting:

OLD="\/fooCommon >"
NEW="~ \"\/fooCommon[^\/]*\" >"
DPATH="/myhome/aru/conf/host*.conf"
BPATH="/myhome/aru/conf/bakup"
TFILE="/myhome/aru/out.tmp.$$"
[ ! -d $BPATH ] && mkdir -p $BPATH || :
for f in $DPATH
do
  if [ -f $f -a -r $f ]; then
   /bin/cp -f $f $BPATH
   echo sed \"s\/$OLD\/$NEW\/g\"
   sed "s/$OLD/$NEW/g" "$f" > $TFILE && mv $TFILE "$f"
  else
   echo "Error: Cannot read $f"

fi
done
/bin/rm $TFILE

Answer 1

While it can be done from the command line, sometimes you just want an easily usable script that provides a bit more useful output. With that in mind, here is a perl solution with friendly output for anyone that runs across this question.

#!/usr/bin/env perl5.8.3

# subst [-v] [-f] "re/string to find" "string to replace" -- list of files
#  optional -v flag shows each line with replacement, must be 1st arg to script
#  optional -f flag says to disable regexp functionality and make the strings match exactly
#  replacement string may include back references ($1, $2, etc) to items in "string to find" if they are surrounded by grouping parenthesis

use strict;
use warnings;
use List::Util;
use IO::File;
use Fcntl;
use Getopt::Long qw(GetOptions);

my $verbose = 0;
my $fixed   = 0;

GetOptions("v" => \$verbose,
           "f" => \$fixed);

my $find    = shift @ARGV;
my $replace = shift @ARGV;

die "Error: missing 1st arg, string to find\n"         if not defined $find;
die "Error: missing 2nd arg, string to replace with\n" if not defined $replace;
die "No files were specified\n"                        if @ARGV == 0;

# open a temp file for writing changes to
my $TEMP = IO::File->new_tmpfile;
if (not defined $TEMP)
{
    print STDERR "ERROR: failed to create temp file: $!\n";
    exit 1;
}

# Fix max file name width for printing
my $fwidth = List::Util::max map { length $_ } @ARGV;

# Process each file
my $unchanged = 0;
my $changed   = 0;
foreach my $file (@ARGV)
{
    if (open(my $FILE, '<', $file))
    {
        # Reset temp file
        seek $TEMP, 0, SEEK_SET or die "ERROR: seek in temp file failed: $!";
        truncate $TEMP, 0       or die "ERROR: truncate of temp file failed: $!";

        # go through the file, replacing strings
        my $changes = 0;
        while(defined(my $line = <$FILE>))
        {
            if ($line =~ m/$find/g)
            {
                print "-" . $line if $verbose;
                print "\n" if $verbose and $line !~ m/\n$/;

                if ($fixed)
                {
                    my $index = index($line, $find);
                    substr($line, $index, length($find)) = $replace;
                }
                else
                {
                    $line =~ s/$find/replacebackrefs($replace)/eg;
                }

                $changes++;
                print "+" . $line if $verbose;
                print "\n" if $verbose and $line !~ m/\n$/;
            }

            print $TEMP $line;
        }
        close $FILE;

        if ($changes == 0)
        {
            $unchanged++;
            unlink("/tmp/subst$$");
            next;
        }

        # Move new contents into old file
        $changed++;
        printf "%*s - %3d changes\n", -$fwidth, $file, $changes;

        seek $TEMP, 0, SEEK_SET or die "ERROR: rewind of temp file failed: $!";
        open $FILE, '>', $file or die "ERROR: failed to re-write $file: $!\n";
        while (<$TEMP>) { print $FILE $_ }
        close $FILE;

        print "\n" if $verbose;
    }
    else
    {
        print STDERR "Error opening $file: $!\n";
    }
}

close $TEMP;

print "\n";
print "$changed files changed, $unchanged files unchanged\n";

exit 0;

sub replacebackrefs
{
    # 1st/only argument is the text matched
    my $matchedtext = shift @_;

    my @backref;
    # @- is a dynamic variable that holds the offsets of submatches in
    # the currently active dynamic scope (i.e. within each regexp
    # match), corresponding to grouping parentheses. We use the count
    # of entrees in @- to determine how many matches there were and
    # store them into an array. Note that @- index [0] is not
    # interesting to us because it has a special meaning (see man
    # perlvar for @-)\, and that backrefs start with $1 not $0.
    # We cannot do the actual replacement within this loop.
    do
    {
        no strict 'refs'; # turn of warnings of dynamic variables
        foreach my $matchnum (1 .. $#-)
        {
            $backref[$matchnum] = ${$matchnum}; # i.e. $1 or $2 ...
        }
    } while(0);

    # now actually replace each back reference in the matched text
    # with the saved submatches.
    $matchedtext =~ s/\$(\d+)/$backref[$1]/g;

    # return a scalar string to actually use as the replacement text,
    # with all the backreferences in the matched text replaced with
    # their submatch text.
    return $matchedtext;
}

Answer 2

If you are on Unix like platform, you can do it using Perl on the command line; no need to write a script.

perl -i -p -e 's/old/new/g;' *.config

TO be on the safer side, you may want to use the command with the backup option.

perl -i.bak  -p -e 's/old/new/g;' *.config

Answer 3

Perl here is just to modify files... I don't understand why to write it whole in perl if you can do it much simpler like this:

find . -maxdepth 1 -type f -name '*.conf' | \
    xargs perl -i.bak -pe 's/localhost/example.com/;'

Answer 4

Perhaps the following will be helpful:

use strict;
use warnings;

my %replacements =
  map { chomp; my @x = split /\|/; $x[0] => [ $x[1], $x[2] ] } <DATA>;

local $^I = '.bak';

for my $file (<*.config>) {
    push @ARGV, $file;

    while (<>) {
        s/\b\Q$replacements{$file}[0]/$replacements{$file}[1]/g;
        print;
    }
}

__DATA__
my_foo.config|fooCommon >|~ /fooCommon[/ >
my_bar.config|barCommon >|~ /barCommon[/ >
my_file.config|someCommon >|~ /someCommon[/ >

A hash of arrays (HoA) is built by splitting the |-delimited DATA lines, where the key is the file name and the value is a reference to an anonymous array whose two elements are for the substitution on the file. The local $^I = '.bak' notation creates backups of the original files.

You may need to adjust the substitution. For example, word boundaries are observed in the substitution by using \b in s/\b\Q$replacements{$file}[0]/$replacements{$file}[1]/g;. You may or may not need (or want) this.

I'd suggest trying it on only one 'scratch' file first, to insure you're getting the results you want, before fully implementing it--even though the original files are backed up.

Answer 5

Your script is a good attempt.

It contains a few redundancies:

• it is useless to cp $f
• $TFILE is useless as well (just write the sed output to the target file directly)

You can construct $NEW and the target filename from the value of $f without the directory path, which you can obtain as follows:

bf=`basename "$f"`

Answer 6

In case you really need to do this with perl only, which I don't recommend as there are excellent and simpler answers already posted, here goes:

#!/usr/bin/perl

# take the directory to be processed from first command line argument
opendir($dh, $ARGV[0]);
# take only relevant files ie. "*.config"
@cfgs = grep { /\.config$/ } readdir($dh);
# loop through files
foreach(@cfgs) {
  # generate source string from the filename
  ($s) = ($_ =~ /.*_(\w+)\.config.*/);
  $s = "${s}Common";
  # generate replacement string from the filename
  $r = "~ /${s}[/ >";
  # move original file to a backup
  rename("${ARGV[0]}${_}", "${ARGV[0]}${_}.bak");
  # open backup file for reading
  open(I, "< ${ARGV[0]}${_}.bak");
  # open a new file, with original name for writing
  open(O, "> ${ARGV[0]}${_}");
  # go through the file, replacing strings
  while(<I>) { $_ =~ s/$s/$r/g; print O $_; }
  # close files
  close(I);
  close(O);
}

# end of file.

Please note that doing this with simple find and or shell wildcards is much simpler. But take this as a little tutorial on how to process files with perl anyway.