Need Perl inplace editing of files not on command line - perl

I have a program that has a number of filenames configured internally. The program edits a bunch of configuration files associated with a database account, and then changes the database password for the database account.
The list of configuration files is associated with the name of the database account via an internal list. When I process these files, I have the following loop in my program:
BEGIN { $^I = '.oldPW'; } # Enable in-place editing
...
foreach (#{$Services{$request}{'files'}})
{
my $filename = $Services{$request}{'configDir'} . '/' . $_;
print "Processing ${filename}\n";
open CONFIGFILE, '+<', $filename or warn $!;
while (<CONFIGFILE>)
{
s/$oldPass/$newPass/;
print;
}
close CONFIGFILE;
}
The problem is, this writes the modified output to STDOUT, not CONFIGFILE. How do I get this to actually edit inplace? Move the $^I inside the loop? Print CONFIGFILE? I'm stumped.
>
Update: I found what I was looking for on PerlMonks. You can use a local ARGV inside the loop to do inplace editing in the normal Perl way. The above loop now looks like:
foreach (#{$Services{$request}{'files'}})
{
my $filename = $Services{$request}{'configDir'} . '/' . $_;
print "Processing ${filename}\n";
{
local #ARGV = ( $filename);
while (<>)
{
s/$oldPass/$newPass/;
print;
}
}
}
If it weren't for tacking the configDir on the beginning, I could just toss the whole list into the local #ARGV, but this is efficient enough.
Thanks for the helpful suggestions on Tie::File. I'd probably go that way if doing this over. The configuration files I'm editing are never more than a few KB in length, so a Tie wouldn't use too much memory.

The recent versions of File::Slurp provide convenient functions, edit_file and edit_file_lines. The inner part of your code would look:
use File::Slurp qw(edit_file);
edit_file { s/$oldPass/$newPass/g } $filename;

The $^I variable only operates on the sequence of filenames held in $ARGV using the empty <> construction. Maybe something like this would work:
BEGIN { $^I = '.oldPW'; } # Enable in-place editing
...
local #ARGV = map {
$Services{$request}{'configDir'} . '/' . $_
} #{$Services{$request}{'files'}};
while (<>) {
s/$oldPass/$newPass/;
# print? print ARGVOUT? I don't remember
print ARGVOUT;
}
but if it's not a simple script and you need #ARGV and STDOUT for other purposes, you're probably better off using something like Tie::File for this task:
use Tie::File;
foreach (#{$Services{$request}{'files'}})
{
my $filename = $Services{$request}{'configDir'} . '/' . $_;
# make the backup yourself
system("cp $filename $filename.oldPW"); # also consider File::Copy
my #array;
tie #array, 'Tie::File', $filename;
# now edit #array
s/$oldPass/$newPass/ for #array;
# untie to trigger rewriting the file
untie #array;
}

Tie::File has already been mentioned, and is very simple. Avoiding the -i switch is probably a good idea for non-command-line scripts. If you're looking to avoid Tie::File, the standard solution is this:
Open a file for input
Open a temp file for output
Read a line from input file.
Modify the line in whatever way you like.
Write the new line out to your temp file.
Loop to next line, etc.
Close input and output files.
Rename input file to some backup name, such as appending .bak to filename.
Rename temporary output file to original input filename.
This is essentially what goes on behind the scenes with the -i.bak switch anyway, but with added flexibility.

Related

How can I know if diamond operator moved to the next file?

I have the following code in a file perl_script.pl:
while (my $line = <>) {
chomp $line;
// etc.
}.
I call the script with more than 1 file e.g.
perl perl_script.pl file1.txt file2.txt
Is there a way to know if the $line is started to read from file2.txt etc?
The $ARGV variable
Contains the name of the current file when reading from <>
and you can save the name and test on every line to see if it changed, updating when it does.
If it is really just about getting to a specific file, as the question seems to say, then it's easier since you can also use #ARGV, which contains command-line arguments, to test directly for the needed name.
One other option is to use eof (the form without parenthesis!) to test for end of file so you'll know that the next file is coming in the next iteration -- so you'll need a flag of some sort as well.
A variation on this is to explicitly close the filehandle at the end of each file so that $. gets reset for each new file, what normally doesn't happen for <>, and then $. == 1 is the first line of a newly opened file
while (<>) {
if ($. == 1) { say "new file: $ARGV" }
}
continue {
close ARGV if eof;
}
A useful trick which is documented in perldoc -f eof is the } continue { close ARGV if eof } idiom on a while (<>) loop. This causes $. (input line number) to be reset between files of the ARGV iteration, meaning that it will always be 1 on the first line of a given file.
There's the eof trick, but good luck explaining that to people. I usually find that I want to do something with the old filename too.
Depending on what you want to do, you can track the filename you're
working on so you can recognize when you change to a new file. That way
you know both names at the same time:
use v5.10;
my %line_count;
my $current_file = $ARGV[0];
while( <> ) {
if( $ARGV ne $current_file ) {
say "Change of file from $current_file to $ARGV";
$current_file = $ARGV;
}
$line_count{$ARGV}++
}
use Data::Dumper;
say Dumper( \%line_count );
Now you see when the file changes, and you can use $ARGV
Change of file from cache-filler.pl to common.pl
Change of file from common.pl to wc.pl
Change of file from wc.pl to wordpress_posts.pl
$VAR1 = {
'cache-filler.pl' => 102,
'common.pl' => 13,
'wordpress_posts.pl' => 214,
'wc.pl' => 15
};
Depending what I'm doing, I might not let the diamond operator do all
the work. This give me a lot more control over what's happening and
how I can respond to things:
foreach my $arg ( #ARGV ) {
next unless open my $fh, '<', $arg;
while( <$fh> ) {
...
}
}

Unable to redirect the output of the system command to a file named error.log and stderr to another file named test_file.errorlog

This perl script is traversing all directories and sub directories, searching for a file named RUN in it. Then it opens the file and runs the 1st line written in the file. The problem is that I am not able to redirect the output of the system command to a file named error.log and STDERR to another file named test_file.errorlog, but no such file is created.
Note that all variable are declared if not found.
find (\&pickup_run,$path_to_search);
### Subroutine for extracting path of directories with RUN FILE PRESENT
sub pickup_run {
if ($File::Find::name =~/RUN/) {
### If RUN file is present , push it into array named run_file_present
push(#run_file_present,$File::Find::name);
}
}
###### Iterate over the array containing paths to directories containing RUN files one by one
foreach my $var (#run_file_present) {
$var =~ s/\//\\/g;
($path_minus_run=$var) =~ s/RUN\b//;
#print "$path_minus_run\n";
my $test_case_name;
($test_case_name=$path_minus_run) =~ s/expression to be replced//g;
chdir "$path_minus_run";
########While iterating over the paths, open each file
open data, "$var";
#####Run the first two lines containing commands
my #lines = <data>;
my $return_code=system (" $lines[0] >error.log 2>test_file.errorlog");
if($return_code) {
print "$test_case_name \t \t FAIL \n";
}
else {
print "$test_case_name \t \t PASS \n";
}
close (data);
}
The problem is almost certainly that $lines[0] has a newline at the end after being read from the file
But there are several improvements you could make
Always use strict and use warnings at the top of every Perl program, and declare all your variables using my as close as possible to their first point of use
Use the three-parameter form of open and always check whether it succeeded, putting the built-in variable $! into your die string to say why it failed. You can also use autodie to save writing the code for this manually for every open, but it requires Perl v5.10.1 or better
You shouldn't put quotes around scalar variables -- just used them as they are. so chdir $path_minus_run and open data, $var are correct
There is also no need to save all the files to be processed and deal with them later. Within the wanted subroutine, File::Find sets you up with $File::Find::dir set to the directory containing the file, and $_ set to the bare file name without a path. It also does a chdir to the directory for you, so the context is ideal for processing the file
use strict;
use warnings;
use v5.10.1;
use autodie;
use File::Find;
my $path_to_search;
find( \&pickup_run, $path_to_search );
sub pickup_run {
return unless -f and $_ eq 'RUN';
my $cmd = do {
open my $fh, '<', $_;
<$fh>;
};
chomp $cmd;
( my $test_name = $File::Find::dir ) =~ s/expression to be replaced//g;
my $retcode = system( "$cmd >error.log 2>test_file.errorlog" );
printf "%s\t\t%s\n", $test_name, $retcode ? 'FAIL' : 'PASS';
}

Perl Find - No such file or directory

I am using File::Find and file i/o on a text file to parse a series of directories and move the contents into a new folder. It is a simple script (see below):
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
use File::Copy;
my $dir = "/opt/CollectMinderDocuments/coastalalglive"; #base directory for Coastal documents
#read file that contains a list of closed IDs
open(MYDATA, "Closed.txt");
mkdir("Closed");
while(my $line = <MYDATA>) {
chomp $line;
my $str = "$dir" . "/Account$line";
print "$str\n";
find(\&move_documents, $str);
}
sub move_documents {
my $smallStr = substr $File::Find::name, 43;
if(-d) {
#system("mkdir ~/Desktop/Closed/$smallStr");
print "I'm here\n";
system("mkdir /opt/CollectMinderDocuments/coastalalglive/Closed/$smallStr");
#print "Made a directory: /opt/CollectMinderDocuments/coastalalglive/Closed/$smallStr\n";
}
else {
print "Now I'm here\n";
my $smallerStr = substr $File::Find::dir, 43;
my $temp = "mv * /opt/CollectMinderDocuments/coastalalglive/Closed/$smallerStr/";
system("$temp");
}
}
The text file contains a list of numbers:
1234
2805
5467
The code worked when I executed it last month, but it is now returning a "file or directory not found" error. The actual error is "No such file or directoryerDocuments/coastalalglive/Account2805". I know all of the directories it is searching for exist. I have manually typed in one of the directories, and the script executes fine:
find(\&move_documents, "/opt/CollectMinderDocuments/coastalalglive/Account2805/");
I am not sure why the error is being returned. Thanks in advance for the help.
Your error:
"No such file or directoryerDocuments/coastalalglive/Account2805"
Seems to imply that there is an \r that was not removed by your chomp. That will happen when transferring files between different file systems, where the file contains \r\n as line endings. The real error string would be something like:
/opt/CollectMinderDocuments/coastalalglive/Account2805\r: No such file or directory
Try changing chomp $line to $line =~ s/[\r\n]+$//; instead, and see if that works.
Also:
my $temp = "mv * /opt/CollectMinderDocuments/coastalalglive/Closed/$smallerStr/";
system("$temp");
Is very wrong. The first non-directory file in that loop will move all the remaining files (including dirs? not sure if mv does that by default). Hence, subsequent iterations of the subroutine will find nothing to move, also causing a "Not found" type error. Though not one caught by perl, since you are using system instead of File::Copy::move. E.g.:
move $_, "/opt/CollectMinderDocuments/coastalalglive/Closed/$smallerStr/" or die $!;

Perl - Command line input and STDIN

I've created this script below for a assignment I have. It asks for a text file, checks the frequency of words, and lists the 10 words that appear the most times. Everything is working fine, but I need this script to be able to start via the command line as well as via the standard input.
So I need to be able to write 'perl wfreq.pl example.txt' and that should start the script and not ask the question for a text file. I'm not sure how to accomplish this really. I think I might need a while loop at the start somewhere that skips the STDIN if you give it the text file on a terminal command line.
How can I do it?
The script
#! /usr/bin/perl
use utf8;
use warnings;
print "Please enter the name of the file: \n" ;
$file = <STDIN>;
chop $file;
open(my $DATA, "<:utf8", $file) or die "Oops!!: $!";
binmode STDOUT, ":utf8";
while(<$DATA>) {
tr/A-Za-z//cs;
s/[;:()".,!?]/ /gio;
foreach $word (split(' ', lc $_)) {
$freq{$word}++;
}
}
foreach $word (sort { $freq{$b} <=> $freq{$a} } keys %freq) {
#fr = (#fr, $freq{$word});
#ord = (#ord, $word);
}
for ($v =0; $v < 10; $v++) {
print " $fr[$v] | $ord[$v]\n";
}
Instead of reading from <STDIN>, you can read from <> to get data either from files provided on the command line or from stdin if there are no files.
For example, with the program:
#!/usr/bin/env perl
while (<>) {
print $_;
}
The command ./script foo.txt will read and print lines from foo.txt, while ./script by itself will read and print lines from standard input.
You need to do the following:
my $DATA;
my $filename = $ARGV[0];
unless ($filename) {
print "Enter filename:\n";
$filename = <STDIN>;
chomp $filename;
}
open($DATA, $filename) or die $!;
Though I have to say, user-prompts are very un-Unix like.
perl script.pl < input.txt
The use of the operator < passes input.txt to script.pl as standard input. You can then skip querying for the filename. Otherwise, use $ARGV[0] or similar, if defined.
You can check for a command-line argument in #ARGV, which is Perl's array that automagically grabs command line arguments, and --if present-- process them (else continue with input from STDIN). Something like:
use utf8;
use strict; #Don't ever forget this! Always, always, ALWAYS use strict!
use warnings;
if(#ARGV)
{
#Assume that the first command line argument is a file to be processed as in your original code.
#You may or may not want to care if additional command line arguments are passed. Up to you.
}
else
{
#Ask for the filename and proceed as normal.
}
Note that you might want to isolate the code for processing the file name (i.e., the opening of DATA, going through the lines, counting the words, etc.) to a subroutine that you can easily call (perhaps with an argument consisting of the file name) in each branch of the code.
Oh, and to make sure I'm clear about this: always use strict and always use warnings. If you don't, you're asking for trouble.

Perl editting a file

I'm trying to open a file, search for a specific string in the file to begin my search from and then performing a replacement on a string later on in the file. For example, my file looks like:
Test Old
Hello World
Old
Data
Begin_search_here
New Data
Old Data
New Data
I want to open the file, begin my search from "Begin_search_here" and then replace the next instance of the word "Old" with "New". My code is shown below and I'm correctly finding the string, but for some reason I'm not writing in the correct location.
open(FILE, "+<$filename") || die "problem opening file";
my search = 0;
while(my $line = <FILE>)
{
if($line =~ m/Begin_search_here/)
{
$search = 1;
}
if($search == 1 && $line =~m/Old/)
{
$line = s/Old/New/;
print FILE $line
}
close FILE;
Here ya go:
local $^I = '.bak';
local #ARGV = ($filename);
local $_;
my $replaced = 0;
while (<>) {
if (!$replaced && /Begin_search_here/ .. $replaced) {
$replaced = s/Old/New/;
}
print;
}
Explanation:
Setting the $^I variable enables inplace editing, just as if you had run perl with the -i flag. The original file will be saved with the same name as the original file, but with the extension ".bak"; replace ".bak" with "" if you don't want a backup made.
#ARGV is set to the list of files to do inplace editing on; here just your single file named in the variable $filename.
$_ is localized to prevent overwriting this commonly-used variable in the event this code snippet occurs in a subroutine.
The flip-flop operator .. is used to figure out what part of the file to perform substitutions in. It will be false until the first time a line matching the pattern Begin_search_here is encountered, and then will remain true until the first time a substitution occurs (as recorded in the variable $replaced), when it will turn off.
You would probably be best served by opening the input file in read mode (open( my $fh, '<', $file ) or die ...;), and writing the modified text to a temporary output file, then copying the temporary file overtop of the input file when you're done doing your processing.
You are misusing the random-access file mode. By the time you update $line and say print FILE $line, the "cursor" of your filehandle is already positioned at the beginning of the next line. So the original line is not changed and the next line is over-written, instead of overwriting the original line.
Inplace editing (see perlrun) looks like it would be well suited for this problem.
Otherwise, you need to read up on the tell function to save your file position before you read a line and seek back to that position before you rewrite the line. Oh, and the data that you write must be exactly the same size as the data you are overwriting, or you will totally fubar your file -- see this question.
I have done a number of edits like this, that I came up with a generic (yet stripped-down) strategy:
use strict;
use warnings;
use English qw<$INPLACE_EDIT>;
use Params::Util qw<_CODE>;
local $INPLACE_EDIT = '.bak';
local #ARGV = '/path/to/file';
my #line_actions
= ( qr/^Begin_search_here/
, qr/^Old Data/ => sub { s/^Old/New/ }
);
my $match = shift #line_actions;
while ( <> ) {
if ( $match and /$match/ ) {
if ( _CODE( $line_actions[0] )) {
shift( #line_actions )->( $_ );
}
$match = shift #line_actions;
}
print;
}
This works. It will, as you specified, only replaces one occurrence.
#! /usr/bin/perl -pi.bak
if (not $match_state) {
if (/Begin_search_here/) {
$match_state = "accepting";
}
}
elsif ($match_state eq "accepting") {
if (s/Old/New/) {
$match_state = "done";
}
}
Be very careful about editing a file in place. If the data you're replacing is a different length, you wreck the file. Also, if your program fails in the middle, you end up with a destroyed file.
Your best bet is to read in each line, process the line, and write each line to a new file. This will even allow you to run your program, examine the output, and if you have an error, fix it and rerun the program. Then, once everything is okay, add in the step to move your new file to the old name.
I've been using Perl since version 3.x, and I can't think of a single time I modified a file in place.
use strict;
use warnings;
open (INPUT, "$oldfile") or die qq(Can't open file "$oldFile" for reading);
open (OUTPUT, "$oldfile.$$") or die qq(Can't open file "$oldfile.$$" for writing);
my $startFlag = 0;
while (my $line = <INPUT>) {
if ($line ~= /Begin_search_here/) {
$startFlag = 1;
}
if ($startFlag) {
$line =~ s/New/Old/;
}
print OUTPUT "$line";
}
#
# Only implement these two steps once you've tested your program
#
unlink $oldfile;
rename $oldfile.$$", $oldfile;