symgryph has asked for the wisdom of the Perl Monks concerning the following question:

I wrote this snippet of code to allow me to 'easily' change files via program rather than hand editing. I made 3 subroutines that take input, and then perform edits on the file.

Here are the problems:

1. the code calls the subroutine once for each set of changes, resulting in LOTS of files being written to if I want to make multiple changes to a file, for example, replace foo with bar, and then delete the line containing foobaz.

2. As a result of multiple calls, the 'backup' files really aren't that useful, since it overwrites the original.

Any way to make this routine more generic, and able to handle multiple inserts, and deletes with only 1 call of the subroutine?

# This is more of a code snippet to include in programs. # It provides for insert, delete, and change functionality to lines of + text # within given files. Each of the subroutines takes a set of paramate +rs to invoke it. # Text below documents the usage for each of the subroutines # # insert_line uses three paramaters, the first of which is the filenam +e to insert a line into, # the second which is the line after which you want the input inserted + into, and the third which # is the text you want inserted into the file. # # search_replace uses three parameters, the first being the filename t +o be worked on, the second # being the text to search for, and the third being the text to replac +e the searched text with. # # delete_line uses two paramaters, the name of the file to delete the +text from, and the name of # the text to strike from the file. Below is invocation of delete_line +s function example # # my $filename="file"; # the filename # my $delete="Hello"; #Things to search for to insert after # my $replace="Goodbye!"; #Thing to insert. # delete_line($filename,$delete); # # to enable searching for perl regular expressions, here is an invocat +ion example: # my $search=qr{perl regular expressions}; e.g. \d+ #Uncomment the code below to call the function # # #This subroutine takes 3 paramaters, 1. the file to edit, 2. the thing + to search for, 3. text # to be inserted after the found item. It backs up the old file, crea +tes a new file, and then #the new file moviing the old file to .bak. ## sub insert_line { my $file=$_[0]; # Name of file to edit my $old = $file; # Old file my $new = "$file.tmp.$$"; #New File to create my $bak = "$file.bak"; #backup of old file my $after = $_[1]; #the thing to insert the line after (text) my $insertline = $_[2]; #the thing to insert itself $old = $file; $new = "$file.tmp.$$"; $bak = "$file.bak"; open (OLD, "< $old") or die "Can't open $old: $!"; open (NEW, "> $new") or die "Can't open $new: $!"; while (<OLD>) { if (/$after/) { $_ .= $insertline; } (print NEW $_); } close (OLD); close (NEW); rename ($old, $bak); rename ($new, $old); } # #this subroutine changes one thing to another in a file. #It takes 3 paramaters, The filename, the thing to find, and the thing + to replace. sub search_replace { my $file= $_[0]; my $old = $file; my $new = "$file.tmp.$$"; my $bak = "$file.bak"; my $find = $_[1]; my $replace = $_[2]; open (OLD, "< $old") or die "Can't open $old: $!"; open (NEW, "> $new") or die "Can't open $new: $!"; while (<OLD>) { s/$find/$replace/g; (print NEW $_); } close (OLD); close (NEW); rename ($old, $bak); rename ($new, $old); } # #This subroutine deletes a line in a file. It takes two arguments, th +e filename to operate on, #and line containing the text to be deleted. # sub delete_line { my $file= $_[0]; my $old = $file; my $new = "$file.tmp.$$"; my $bak = "$file.bak"; my $delete = $_[1]; open (OLD, "< $old") or die "Can't open $old: $!"; open (NEW, "> $new") or die "Can't open $new: $!"; while (<OLD>) { if (/$delete/) { $_= ""; } (print NEW $_); } close (OLD); close (NEW); rename ($old, $bak); rename ($new, $old);
"Two Wheels good, Four wheels bad."

Replies are listed 'Best First'.
Re: Perl File Editing Subroutines, Any ideas?
by Fletch (Bishop) on Jun 08, 2007 at 20:41 UTC

    Wow, you're already well on your way to (poorly) reimplementing sed in Perl. The circle is now complete.

Re: Perl File Editing Subroutines, Any ideas?
by GrandFather (Saint) on Jun 08, 2007 at 23:04 UTC

    Slurp the file, edit the lines, write the file back out:

    use strict; use warnings; my @edits = ( delete => ['my'], delete => ['open'], delete => ['rename'], delete => ['{'], delete => ['}'], delete => ['^\\s*$'], delete => ['\\$_'], replace => ['use.*;', '# Strictures are really important'], ); edit ('noname.txt', @edits); sub edit { my ($file, @edits) = @_; my $old = $file; # Old file my $new = "$file.tmp.$$"; #New File to create my $bak = "$file.bak"; #backup of old file my %dispatch = ( insert => \&insert_line, delete => \&delete_line, replace => \&search_replace, ); $old = $file; $new = "$file.tmp.$$"; $bak = "$file.bak"; open my $OLD, '<', $old or die "Can't open $old: $!"; my $inLines; @$inLines = <$OLD>; close ($OLD); while (@edits >= 2) { my ($edit, $params) = splice @edits, 0, 2; my $outLines = []; next unless exists $dispatch{$edit}; $dispatch{$edit}->($inLines, $outLines, @$params); $inLines = $outLines; } open my $NEW, '>', $new or die "Can't open $new: $!"; print $NEW @$inLines; close ($NEW); rename ($old, $bak); rename ($new, $old); } sub insert_line { my ($in, $out, $after, $insertline) = @_; for (@$in) { $_ .= $insertline if /$after/; push @$out, $_; } } sub search_replace { my ($in, $out, $find, $replace) = @_; for (@$in) { s/$find/$replace/g; push @$out, $_; } } sub delete_line { my ($in, $out, $delete) = @_; for (@$in) { push @$out, $_ unless /$delete/; } }

    run against itself generates:

    # Strictures are really important # Strictures are really important replace => ['# Strictures are really important', '# Strictures are + really important'], ); edit ('noname.txt', @edits); insert => \&insert_line, delete => \&delete_line, replace => \&search_replace, ); $old = $file; $new = "$file.tmp.$$"; $bak = "$file.bak"; @$inLines = <$OLD>; close ($OLD); $inLines = $outLines; print $NEW @$inLines; close ($NEW); s/$find/$replace/g;

    DWIM is Perl's answer to Gödel
Re: Perl File Editing Subroutines, Any ideas?
by ww (Archbishop) on Jun 08, 2007 at 21:33 UTC

    Not what you asked for, but re the backup files lack of usefulness, you might consider using a flag to indicate that a particular file has or has not already been changed... and use the value of that flag to determine whether to rename the file being changed to -- say -- file.old, if you're making the first change of this run or to .bak, on subsequent encounters with the same file.

    Alternately, you could make your sub do a rename to file.(OPTIONAL: time_of_action).old, unless the particular file.old exists already, in which case, it should rename to file.bak.

    The second notion is probably simpler to implement, but will rely on good housekeeping. I gather you want to be able to compare or diff the original with the revisions after this snippet completes, but then, immediately, you have to unlink or del the .olds, because failing to do so will bork the logic on the next run (which might even be before your first is finished in a multi-user environment).

Re: Perl File Editing Subroutines, Any ideas?
by andreas1234567 (Vicar) on Jun 09, 2007 at 18:17 UTC
    You should read the perl.com article FMTYEWTK About Mass Edits In Perl by Geoff Broadwell

    Example: Running Multiple Regexes on Multiple Files

    perl -pi.bak -e "s/Bill Gates/Microsoft CEO/g; s/CEO/Overlord/g" <FileList>
    --
    print map{chr}unpack(q{A3}x24,q{074117115116032097110111116104101114032080101114108032104097099107101114})