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
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");
&bakkup;
#&writePets; #just write a new file and replace the old one
&rewritePets;
rename ("$newFile","$petFile") ||&err("Could not overwrite pet file");
exit;
sub bakkup {
my $archive ="/home/devsite/bakTEST/$todayUTS.tar.gz";
my @filesToBackup = ("$petFile");
my $failed;
my $failed2;
$backupStatus.="Failed to begin backup $! \n" unless defined(my
$pid=open(CHILD, "-|" ));
if ($pid) {
while (<CHILD>) { }
close CHILD;
} else {
system
("/bin/tar","-czf",$archive,@filesToBackup)==0 or $backupStatus.="Failed
system call\n";
my $failed=$?>>8; #n.b. $_ and $! not useful here
}
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,"-|"));
if ($test) {
while (<KID>) { }
close KID;
} else {
system
("/bin/tar","-tzf",$archive)==0 or $backupStatus.="Failed system call\n";
my $failed2=$?>>8;
}
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]");
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]");
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 $!");
}
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
