Jo for lists and groups wrote:
Greetings All! I am stumped and hoping someone can help solve this mystery.
It seems I have introduced a bug in my script while attempting to move from
a simple duplicate file backup (using File::Copy copy) to a tar.gz method to
conserve space.
I've cut out most of the extraneous stuff, what's left still illustrates the
problem. I am attempting to add a single pet to an existing file. Instead of
adding 1 new tweety bird, I am get 4 new tweety birds.
Script is way below after my notes here.
Starting content of /home/devsite/.pets.txt
dog:fido
cat:kitty
1. If script is set to run as intended like this
the newly replaced file has 4 birds more than before
&bakkup;
#&writePets;
&rewritePets;
rename ("$newFile","$petFile");
exit;
2. Skip the backup subroutine, it works
the newly replaced file has only 1 bird more than before
#&bakkup;
#&writePets;
&rewritePets;
rename ("$newFile","$petFile");
exit;
3. Stop short of the renaming, it works -
the new file has only the 1 tweety more than the old file
... Problem with rename?
&bakkup;
#&writePets;
&rewritePets;
#rename ("$newFile","$petFile");
exit;
4. Instead try to just write a new file (ignore the old content) - it works
newly replaced file has only 1 bird (though we've lost pre-existing pets)
...shows it's not a problem with rename after all?
&bakkup;
&writePets;
#&rewritePets;
rename ("$newFile","$petFile");
exit;
5. Also tried File::Copy's 'move' in place of 'rename'; same issue.
6. I have tried a sleep delay before rename/move in order to test
whether the old file was just taking a long time to close. Didn't help.
7. I cut out a bit of the rewritePets sub for clarity, in essence it's:
open old file for reading
open new file for writing
read old list line by line, if pet not on deceased list, copy to new list
Close old file
add today's new pet to the list
Close new file
Finally, replace old with new
You see, I don't want to wipe out old list prematurely before new one is
assembled. I can't just append the new pet to the old file because the old
list needs some deletions while I'm at it. The tar backup sub works fine.
Thank-you,
Jo
==========================================================
#!/usr/bin/perl -Tw
Most modern programs use the lexical 'warnings' pragma instead of the
global -w command line switch.
use strict;
$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
my $petFile="/home/devsite/.pets.txt";
my $newFile="/home/devsite/.pets.txt.new";
my $backupStatus;
use Date::Manip;
my $todayUTS=&UnixDate('today',"%s");
No need to import the Date::Manip module as perl provides a built-in
function to do the same thing:
my $todayUTS = time;
&bakkup;
Should be (unless you are using Perl4):
bakkup();
#&writePets; #just write a new file and replace the old one
&rewritePets;
rewritePets();
rename ("$newFile","$petFile") ||&err("Could not overwrite pet file");
You don't have to copy perl variables to strings in order to use them
(perl is not shell). You should include the $! variable in your error
message so you know *why* it failed.
rename $newFile, $petFile or err( "Could not overwrite pet file: $!" );
exit;
If you are going to use exit() you may as well return a value that the
shell can use:
exit 0;
sub bakkup {
my $archive ="/home/devsite/bakTEST/$todayUTS.tar.gz";
my @filesToBackup = ("$petFile");
Or simply:
my @filesToBackup = $petFile;
my $failed;
my $failed2;
$backupStatus.="Failed to begin backup $! \n" unless defined(my
$pid=open(CHILD, "-|" ));
Why are you using open() to fork a process instead of using fork()? Why
are you forking a separate process at all?
if ($pid) {
while (<CHILD>) { }
close CHILD;
} else {
You are now in a child process that is separate from the parent process,
unless fork() failed and $pid is undefined.
system
("/bin/tar","-czf",$archive,@filesToBackup)==0 or $backupStatus.="Failed
system call\n";
my $failed=$?>>8; #n.b. $_ and $! not useful here
Since you don't exit the child process you now have *two* processes
executing the next steps.
}
if ($failed) { $backupStatus.="Failed to backup [tar (pid:$pid)
exited with: $failed ($?)]\n"; }
else {
$backupStatus.="Failed to begin reading $! \n"
unless defined(my $test=open(KID,"-|"));
You now have both the previous parent and child creating a new child
each, resulting in *four* processes.
if ($test) {
while (<KID>) { }
close KID;
} else {
system
("/bin/tar","-tzf",$archive)==0 or $backupStatus.="Failed system call\n";
my $failed2=$?>>8;
Since you don't exit the child process you now have *four* processes
executing the next steps.
}
if ($failed2) { $backupStatus.="Failed to test
backup:tar(pid:$test)exited with:[$failed2]($?)"; }
else { $backupStatus.="Successfully backed
up files"; }
}
}
sub writePets {
open (NEWPETS, ">$newFile")||&err("Could not read old pet file
[$newFile]");
You should include the $! variable in your error message so you know
*why* it failed.
print NEWPETS "bird:TWEETY\n";
close (NEWPETS)||&err("Could not close new pet file $!");
}
sub rewritePets {
open (OLDPETS, "<$petFile")||&err("Could not read old pet file
[$petFile]");
You should include the $! variable in your error message so you know
*why* it failed.
unless (open (NEWPETS, ">$newFile")) {
close (OLDPETS);
&err("Could not create new pet file $newFile");
}
while (<OLDPETS>) {
chomp;
if (/^[a-z]+:[a-z]+$/i) { print NEWPETS "$_\n"; }
}
close (OLDPETS)||&err("Could not close old pet file $!");
print NEWPETS "bird:TWEETY\n";
close (NEWPETS)||&err("Could not close new pet file $!");
}
John
--
Those people who think they know everything are a great
annoyance to those of us who do. -- Isaac Asimov
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
