Perl File Write Issue - perl

I'm having a really weird problem with this perl script. The basic point is that sometimes a file write/append doesn't happen. On a run of the program, either all of the writes will happen or none of them will. Here is the subroutine, with some comments:
sub process_svs {
my $F;
open($F, '<', $_[0]);
if($log_dups==1) {
open($dfh, '>>',"./duplicates.txt");
}
while (my $line = <$F>) {
chomp $line;
if($line =~ /somepattern/) {
if (! -e "somefile") {
copy("source","dest") or warn ("couldn't copy");
} elsif($log_dups==1) {
system("touch ./duplicates.txt"); # ghetto workaround
print $dfh "./".$_[0]."_files/".$1.",v already exists\n" or die("Couldn't write duplicate"); # problem line
}
}
}
close $F;
}
The print statements to stdout always work, but if I remove the touch ./duplicates.txt crap, nothing is written to duplicates.txt.
The other "weird" thing, is that earlier in the program, I create a directory with perl mkdir, and if the directory exists when the program is run, I don't need the workaround, the duplicates.txt writing works just fine. If I delete the directory, and let the program mkdir it, it doesn't work. Seems relevant, but I can't figure out how since the directory and the text file are not in the same location, or related in any way, that I can think of.
Additionally, I have run it through the debugger, and can see the write call being executed, but inspecting duplicates.txt immediately after the write shows nothing written.
Any possible reasons for this would be greatly appreciated.
If you want to see a modified, but more complete, version of the script, it is here:
use strict;
use warnings;
use File::Copy;
my $svs = $ARGV[0];
my $rhis_str = system("rhis $svs > ./tmp_history");
my $fh;
my $dfh;
my #versions;
my $all_revs = 0;
my $current_rev = "";
my $log_dups = 0;
sub process_svs {
my $F;
open($F, '<', $_[0]);
if($log_dups==1) {
open($dfh, '>>',"./duplicates.txt");
}
while (my $line = <$F>) {
chomp $line;
if($line =~ /something/) {
if (! -e "something") {
copy("source","dest") or warn ("couldn't copy ");
} elsif($log_dups==1) {
system("touch ./duplicates.txt"); # ghetto workaround
print $dfh "something already exists\n" or die("Couldn't write duplicate");
}
}
}
close $F;
}
for(my $i = 0; $i <= scalar #ARGV; $i++) {
my $arg = $ARGV[$i];
if($arg eq "-a") {
$all_revs = 1;
} elsif($arg eq "-r") {
$all_revs = 0;
$current_rev = $ARGV[$i+1];
} elsif($arg eq "--log-dups") {
$log_dups = 1;
}
}
open($fh, '<','./tmp_history') or die(">>> Failed to open ./tmp_history");;
mkdir "./".$svs."_files";
if($all_revs == 1) {
print ">>> Processing all revisions of ".$svs;
if($log_dups==1) {
print" (and logging duplicates)\n";
}
while(my $line = <$fh>) {
chomp $line;
if ($line =~ /something/) {
push #versions, $1;
}
}
}
system("some_cmd &>/dev/null");
process_svs($svs);
}

You're not checking to see if your files opened. This is a very, very basic mistake and you should fix this immediately. Either add or die $! after each open or, better yet, use autodie and it will take care of catching all IO exceptions for you and give you good, consistent error messages.
Most importantly, this will tell you why it failed to open. $! tells you why it failed. You don't have that in your check on print.
print $dfh "./".$_[0]."_files/".$1.",v already exists\n" or die("Couldn't write duplicate"); # problem line
You're checking if print failed, but you're not including $!. Either add $! like die "Couldn't write to duplicate: $!" or use autodie, remove the or die clause, and let autodie take care of it. I recommend the second.
I suspect you'll find that something else is deleting duplicates.txt between the open and the print.
The second thing that grabs my attention is here.
if($log_dups==1) {
open($dfh, '>>',"./duplicates.txt");
}
You're using a global variable $log_dups to decide whether or not to open the file for writing (and not checking if it succeeded). This should be a variable that gets passed into the function, it's just good programming practice. Later you decide whether to print to $dfh based on that global variable.
if (! -e "something") {
copy("source","dest") or warn ("couldn't copy ");
} elsif($log_dups==1) {
system("touch ./duplicates.txt"); # ghetto workaround
print $dfh "something already exists\n" or die("Couldn't write duplicate");
}
Because $log_dups is global it's possible something else is changing $log_dups between deciding to open duplicates.txt and writing to it. To avoid all these problems, and to make the code simpler, $log_dups should be an argument passed into the function.
Furthermore, the filehandle $dfh is inexplicably a global. Same problem, something else could be closing it. It will also not be automatically closed at the end of the function which might leave writes to duplicates.txt buffered until the program exits. $dfh should be a lexical.
Other problems...
my $rhis_str = system("rhis $svs > ./tmp_history");
$rhis_str will contain the exit status of the rhis program. I don't think that's what you want. You don't use this variable anyway.
There's no need to pass ./file to open, it's safe and easier to read to use just pass file. That it's in the current working directory is implied.
If you fix these basic problems and still have trouble, then edit your question with the revised code and we can look again.

Related

file handler in perl not working in subroutine

#!/bin/perl
open( $WP, ">/home/Octa.txt" );
# Subroutine test
sub test {
$var1 = shift;
print $WP "TESTING\n";
}
# Subroutine func
sub func {
$var = shift;
if ( $var eq "Ocat" ) {
print $WP "String found\n";
test($var);
}
else {
print $WP "String not found\n";
}
}
$var3 = "Octa";
func($var3);
The issue is that the code is not able to write anything within the test subroutine or within the if condition of the 'funcsubroutine, but it prints in theelse` part of the 'func' subroutine.
First off, there is a typo -- you test $var against "Ocat", while Octa is intended.
So the test subroutine never gets called and only String not found is printed.
With that corrected and with the output file in a user writeable location, your program works.
However, some improvements are necessary.
use warnings;
use strict;
my $file = 'Octa.txt';
open my $WP, '>', $file or die "Can't open $file: $!";
my $var3 = "Octa";
func($WP, $var3);
#Subroutine test
sub test{
my ($fh, $var1) = #_;
print $fh "TESTING\n";
}
#Subroutine func
sub func{
my ($fh, $var) = #_;
if ($var eq "Octa"){
print $fh "String found\n";
test($fh, $var);
}
else {
print $fh "String not found\n";
}
}
I've changed the output file name since a user normally may not write to /home directory.
Comments
It is much better to use the three-argument form of open, in which case you get a lexical file handle which can be passed around nicely and is scoped. This question is a good example of how a global file handle can make things confusing, to say the least.
Always check the open call. For one thing, can you really write to /home directory?
Please always start programs with use warnings; and use strict;
There is another possibility for failure, which brings together practices in the comments above.
A file in /home normally isn't writeable by a user, in which case the posted program cannot work.
But without a check of open (which will fail) and without use warnings (which would be printed every time we touch the invalid $WH filehandle) we will not see any of these errors; instead, the program will quietly run and complete but it won't write the output file.

Picking a specific line with a specific string

I am trying this in Perl to pick one complete line from whole document which contains "CURRENT_RUN_ID". I have been using below code to accomplish the above said task but I am unable to enter the while loop.
my $sSuccessString = "CURRENT_RUN_ID";
open(LOG, "$slogfile") or die("Can't open $slogfile\n");
my $sLines;
{
local $/ = undef;
$sLines=<LOG>;
}
my $spool = 0;
my #matchingLines;
while (<LOG>)
{
print OUTLOG "in while loop\n";
if (m/$sSuccessString/i) {
print OUTLOG "in if loop\n";
$spool = 1;
print map { "$_ \n" } #matchingLines;
#matchingLines = ();
}
if ($spool) {
push (#matchingLines, $_);
}
}
You are already done reading from the filehandle LOG after you have slurped it into $sLines. <LOG> in the head of the while will return undef because it has reached eof. You either have to use that variable $sLines in your while loop or get rid of it. You're not using it anyway.
If you only want to print the line that matches, all you need to do is this:
use strict;
use warnings;
open my $fh_in, '<', 'input_file' or die $!;
open my $fh_out '>', 'output_file' or die $!;
while (my $line = <$fh_in>) {
print $fh_out $line if $line =~ m/CURRENT_RUN_ID/;
}
close $fh_in;
close $fh_out;
When you execute this code:
$sLines=<LOG>;
it reads all of the data from LOG into $sLines and it leaves the file pointer for LOG at the end of the file. So when you next try to read from that file handle with:
while (<LOG>)
nothing is returned as there is no more data to read.
If you want to read the file twice, then you will need to use the seek() function to reset the file pointer before your second read.
seek LOG, 0, 0;
But, given that you never do anything with $sLines I suspect that you can probably just remove that whole section of the code.
The whole thing with $spool and #matchingLines seems strange too. What were you trying to achieve there?
I think your code can be simplified to just:
my $sSuccessString = "CURRENT_RUN_ID";
open(LOG, $slogfile) or die("Can't open $slogfile\n");
while (<LOG>) {
print OUTLOG if /$sSuccessString/i/;
}
Personally, I'd make it even simpler, by reading from STDIN and writing to STDOUT.
my $sSuccessString = 'CURRENT_RUN_ID';
while (<>) {
print if /$sSuccessString/i/;
}
And then using Unix I/O redirection to connect up the correct files.
$ ./this_filter.pl < your_input.log > your_output.log

perl file read, truncate

I am trying to modify a config file.
I first read it into #buffer, depending on a regex match.
The modified buffer gets written back on disk, in case the file got smaller, a trunciation is done.
Unfortunatly this does not work, and it already crashes at fseek, but as far as I can say my usage of fseek conforms to perl doc.
open (my $file, "+<", "somefilethatexists.txt");
flock ($file, LOCK_EX);
foreach my $line (<$file>) {
if ($line =~ m/(something)*/) {
push (#buffer, $line);
}
}
print "A\n";
seek($file,0,0); #seek to the beginning, we read some data already
print "B\n"; # never appears
write($file, join('\n',#buffer)); #write new data
truncate($file, tell($file)); #get rid of everything beyond the just written data
flock($file, LOCK_UN);
close ($file);
perlopentut says this about Mixing Reads and Writes
... when it comes to updating a file ... you probably don't want to
use this approach for updating.
You should use Tie::File for this. It opens the file for both read and write on the same filehandle and allows you to treat a file as an array of lines
use strict;
use warnings;
use Tie::File;
tie my #file, 'Tie::File', 'somefilethatexists.txt' or die $!;
for (my $i = 0; $i < #file; ) {
if (m/(something)*/) {
$i++;
}
else {
splice #file, $i, 1;
}
}
untie #file;
Where are your fseek(), fwrite() and ftruncate() functions defined? Perl doesn't have those functions. You should be using seek(), print() (or syswrite()) and truncate(). We can't really help you if you're using functions that we know nothing about.
You also don't need (and probably don't want) that explicit call to unlock the file or the call to close the file. The filehandle will be closed and unlocked as soon as your $file variable goes out of scope.
Maybe you can try this:
$^I = '.bak';
#ARGV = 'somefilethatexists.txt';
while (<>) {
if (/(something)*/) {
print;
}
}

Can a Perl subroutine return data but keep processing?

Is there any way to have a subroutine send data back while still processing? For instance (this example used simply to illustrate) - a subroutine reads a file. While it is reading through the file, if some condition is met, then "return" that line and keep processing. I know there are those that will answer - why would you want to do that? and why don't you just ...?, but I really would like to know if this is possible.
A common way to implement this type of functionality is with a callback function:
{
open my $log, '>', 'logfile' or die $!;
sub log_line {print $log #_}
}
sub process_file {
my ($filename, $callback) = #_;
open my $file, '<', $filename or die $!;
local $_;
while (<$file>) {
if (/some condition/) {
$callback->($_)
}
# whatever other processing you need ....
}
}
process_file 'myfile.txt', \&log_line;
or without even naming the callback:
process_file 'myfile.txt', sub {print STDERR #_};
Some languages offer this sort of feature using "generators" or "coroutines", but Perl does not. The generator page linked above has examples in Python, C#, and Ruby (among others).
The Coro module looks like it would be useful for this problem, though I have no idea how it works and no idea whether it does what it advertises.
The easiest way to do this in Perl is probably with an iterator-type solution. For example, here we have a subroutine which forms a closure over a filehandle:
open my $fh, '<', 'some_file.txt' or die $!;
my $iter = sub {
while( my $line = <$fh> ) {
return $line if $line =~ /foo/;
}
return;
}
The sub iterates over the lines until it finds one matching the pattern /foo/ and then returns it, or else returns nothing. (undef in scalar context.) Because the filehandle $fh is defined outsite the scope of the sub, it remains resident in memory between calls. Most importantly, its state, including the current seek position in the file, is retained. So each call to the subroutine resumes reading the file where it last left off.
To use the iterator:
while( defined( my $next_line = $iter->() ) ) {
# do something with each line here
}
If you really want do this you can by using threading. One option would be to fork a separate thread that reads the file and when it finds a certain line, place it in an array that is shared between threads. Then the other thread could take the lines, as they are found, and process them. Here is an example that reads a file, looks for an 'X' in a file's line, and does an action when it is found.
use strict;
use threads;
use threads::shared;
my #ary : shared;
my $thr = threads->create('file_reader');
while(1){
my ($value);
{
lock(#ary);
if ($#ary > -1){
$value = shift(#ary);
print "Found a line to process: $value\n";
}
else{
print "no more lines to process...\n";
}
}
sleep(1);
#process $value
}
sub file_reader{
#File input
open(INPUT, "<test.txt");
while(<INPUT>){
my($line) = $_;
chomp($line);
print "reading $line\n";
if ($line =~ /X/){
print "pushing $line\n";
lock(#ary);
push #ary, $line;
}
sleep(4)
}
close(INPUT);
}
Try this code as the test.txt file:
line 1
line 2X
line 3
line 4X
line 5
line 6
line 7X
line 8
line 9
line 10
line 11
line 12X
If your language supports closures, you may be able to do something like this:
By the way, the function would not keep processing the file, it would run just when you call it, so it may be not what you need.
(This is a javascript like pseudo-code)
function fileReader (filename) {
var file = open(filename);
return function () {
while (s = file.read()) {
if (condition) {
return line;
}
}
return null;
}
}
a = fileReader("myfile");
line1 = a();
line2 = a();
line3 = a();
What about a recursive sub? Re-opening existing filehandles do not reset the input line number, so it carries on from where it's left off.
Here is an example where the process_file subroutine prints out blank-line-separated "\n\n" paragraphs that contain foo.
sub process_file {
my ($fileHandle) = #_;
my $paragraph;
while ( defined(my $line = <$fileHandle>) and not eof(<$fileHandle>) ) {
$paragraph .= $line;
last unless length($line);
}
print $paragraph if $paragraph =~ /foo/;
goto &process_file unless eof($fileHandle);
# goto optimizes the tail recursion and prevents a stack overflow
# redo unless eof($fileHandle); would also work
}
open my $fileHandle, '<', 'file.txt';
process_file($fileHandle);

How do I determine whether a Perl file handle is a read or write handle?

You are given either an IO::File object or a typeglob (\*STDOUT or Symbol::symbol_to_ref("main::FH")); how would you go about determining if it is a read or write handle? The interface cannot be extended to pass this information (I am overriding close to add calls to flush and sync before the actual close).
Currently I am attempting to flush and sync the filehandle and ignoring the error "Invalid argument" (which is what I get when I attempt to flush or sync a read filehandle):
eval { $fh->flush; 1 } or do {
#this seems to exclude flushes on read handles
unless ($! =~ /Invalid argument/) {
croak "could not flush $fh: $!";
}
};
eval { $fh->sync; 1 } or do {
#this seems to exclude syncs on read handles
unless ($! =~ /Invalid argument/) {
croak "could not sync $fh: $!";
}
};
Have a look at the fcntl options. Maybe F_GETFL with O_ACCMODE.
Edit: I did a little googling and playing over lunch and here is some probably non-portable code but it works for my Linux box, and probably any Posix system (perhaps even Cygwin, who knows?).
use strict;
use Fcntl;
use IO::File;
my $file;
my %modes = ( 0 => 'Read only', 1 => 'Write only', 2 => 'Read / Write' );
sub open_type {
my $fh = shift;
my $mode = fcntl($fh, F_GETFL, 0);
print "File is: " . $modes{$mode & 3} . "\n";
}
print "out\n";
$file = new IO::File();
$file->open('> /tmp/out');
open_type($file);
print "\n";
print "in\n";
$file = new IO::File();
$file->open('< /etc/passwd');
open_type($file);
print "\n";
print "both\n";
$file = new IO::File();
$file->open('+< /tmp/out');
open_type($file);
Example output:
$ perl test.pl
out
File is: Write only
in
File is: Read only
both
File is: Read / Write