Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

Write to existing file with character insert

by Mark.Allan (Sexton)
on Oct 24, 2012 at 12:20 UTC ( #1000620=perlquestion: print w/replies, xml ) Need Help??

Mark.Allan has asked for the wisdom of the Perl Monks concerning the following question:


Not sure how this can be so hard but here goes, im trying to search for files in a directory which match a certain pattern, this is easy, when I find these files I want to read through them, search for a string which matches a specific pattern then edit these files by adding an # at the start of the matched line.

Can I do this with one search and replace by appending the current file and editing. I thought this would be simple, it probably is for you gurus but I'm only an "occasional" scripter

Here is what I got so far. I could have multiple files called rc.itm1 or rc.itm2 etc in the /etc dir. So I need to find these files, edit a line which matches "start ux" by inserting an # at the beginning of line

Current code finds the files, finds the string, and prints the string with an # in front but I'm struggling to work out how to successfully search and replace this string in the same file and save it off.

current code....

#!/usr/bin/perl use strict; use warnings; use Data::Dumper; my $dir="/etc"; opendir ( DIR, $dir ) || die "Error in opening dir $dir\n"; my @files=sort(grep(/^rc\.itm\d+$/, readdir(DIR))); closedir(DIR); foreach my $file(@files){ my $this_file=$dir . "/" . $file; print "$this_file\n"; open IN, "< $this_file"; while (<IN>){ if ($_ =~ /start ux/){ print "#$_"; } } }
Can anyone help me out please?

Replies are listed 'Best First'.
Re: Write to existing file with character insert
by Don Coyote (Hermit) on Oct 24, 2012 at 12:39 UTC

    Hi, you want to use a substitution regex operator. the match operator is described as m//, this is the operator you have used. The substition operator is described s///.

    The pattern you wish to match goes in the first section as per a normal match, the pattern you wish to replace in the second section. You can use parentheses in the first section to capture the matched pattern and reuse it in the second section within the special variables $1 through $9

    if ($_ =~ /start ux/){ print "#$_"; }

    (assuming the whole line is a pattern match) becomes...


    if you wanted to insert an octothorpe if the pattern matches anywhere in the line, you could have your regex match the whole line if part of it matches...


    regex operates on the $_ variable, and substitution matching is an 'if' operation in itself. In this case the parentheses match in subsequential order from first open through to second open (pattern matches $2). The outer characters say, anything matches.

Re: Write to existing file with character insert
by Anonymous Monk on Oct 24, 2012 at 12:37 UTC
Re: Write to existing file with character insert
by zwon (Abbot) on Oct 24, 2012 at 16:16 UTC
    I'm struggling to work out how to successfully search and replace this string in the same file and save it off.

    If you inserting or removing something from a file you have to rewrite all the file starting from the place where you're inserting or removing data. Therefore a practical approach is to read data from file, change it as needed, and save into a new file. Then rename new file to replace the original. You don't have to implement it yourself though, just use edit_file_lines function from the File::Slurp module.

      ... unless you know and can guarantee that every single file you may be interested in will fit in the memory of the computers that you will be using to process them. Not a very safe assumption in the general case ... but maybe.
Re: Write to existing file with character insert
by Kenosis (Priest) on Oct 24, 2012 at 19:19 UTC

    Excellent suggestions have been provided. Given them, consider the following which which adds the use of File::Find::Rule to create the list of files for your substitution:

    use strict; use warnings; use File::Slurp qw/ edit_file_lines /; use File::Find::Rule; my @files = File::Find::Rule->file() ->name(qr/^rc\.itm\d+$/) ->prune ->in('/etc'); edit_file_lines { s/(.*start ux)/#$1/ } $_ for @files;

    prune prevents recursion. Note: Try the script on a 'scratch' directory first to verify your getting the desired results.

    Hope this helps!

      prune prevents recursion.

      max_depth(1) also prevents recursion :)

      Based on the previous links I might write this which avoids the slurping of both files and filenames :)

      #!/usr/bin/perl -- use strict; use warnings; use File::Find::Rule; Main( @ARGV ); exit( 0 ); sub Fudge { use Errno(); join qq/\n/, "Error @_", map { " $_" } int( $! ) . q/ / . $!, int( $^E ) . q/ / . $^E, grep( { $!{$_} } keys %! ), q/ /; } sub pie(&@) { my( $cb, $file, $backup ) = @_; $backup ||= "$file~"; $backup = "$file$backup" if length $file > length $backup; rename $file, $backup or die Fudge( "backing up q{$file} to q{$bac +kup}:" ); open my $IN, "<", $backup or die Fudge( "reading q{$backup}:" ); open my $OUT, ">", $file or die Fudge( "writing $file:" ); local $_; while( defined( $_ = <$IN> ) ) { $cb->(); print $OUT $_; } } ## end sub pie(&@) #~ pie { s/^\s+// } "myfile.txt"; #~ pie { s/^\s+// } "myfile.txt", ".orig"; #~ pie { s/^\s+// } "myfile.txt", "myfile.txt.bak"; #~ pie { s/^\s+// } @ARGV; ## $ perltidy -csc -csci=10 -cscl="sub : BEGIN END" -otr -opr -ce -nib +c -i=4 -pt=0 "-nsak=*" #~ my @files = Path::Class::Rule->new->file->name( qr/^rc\.itm\d+$/ )- +>max_depth(1)->all( $dir ); #~ my @files = File::Find::Rule->new->file->name( qr/^rc\.itm\d+$/ )-> +max_depth(1)->in( $dir ); #~ my @files = find( file => name => qr/^rc\.itm\d+$/ => max_depth => +1 => in => $dir ); #~ for my $file( @files ){ #~ pie { #~ m/start ux/ and s{^}{#} #~ } $file; #~ } #~ for my $file( @files ){ #~ pie \&uxcomment, $file; #~ } #~ for my $file( @files ){ #~ eval { pie \&uxcomment, $file } or warn $@; #~ } sub uxcomment { s/^\s+// } sub Main { my $dir = \@_; my $filefinder = find( file => name => qr/^rc\.itm\d+$/, max_depth => 1, start => $dir, ); while( my $file = $filefinder->match ) { eval { pie \&uxcomment, $file } or warn $@; } } ## end sub Main

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1000620]
Approved by Corion
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (4)
As of 2022-12-02 15:42 GMT
Find Nodes?
    Voting Booth?