Browse Source

Fixed errors that occurred when a non-existent file would trip up the

stricter requirements for the newer perl 5.8.
master
freesource 20 years ago
parent
commit
a16a8c79c5
  1. 96
      bin/imswim

96
bin/imswim

@ -48,58 +48,60 @@ line.
=cut =cut
if ($#ARGV == -1) { if ($#ARGV == -1) {
print STDERR "swim: imswim requires arguments, see program for instructions\n"; print STDERR "swim: imswim requires arguments, see program for instructions\n";
exit; exit;
} }
else { else {
$| = 1; my $x = 1; $| = 1; my $x = 1;
open(FILEDIR, ">$ARGV[1]/filedir.deb") open(FILEDIR, ">$ARGV[1]/filedir.deb")
or warn "could not create filedir.deb\n"; or warn "could not create filedir.deb\n";
open(TRANSFER, "$ARGV[1]/transfer.deb") or warn "needs transfer.deb"; open(TRANSFER, "$ARGV[1]/transfer.deb") or warn "needs transfer.deb";
while (<TRANSFER>) { while (<TRANSFER>) {
chomp; chomp;
my @the = split(/_/, $_); my @the = split(/_/, $_);
open (LIST, "$ARGV[0]/$the[0].list") if (-e "$ARGV[0]/$the[0].list") {
or warn "could not file *list"; open (LIST, "$ARGV[0]/$the[0].list")
or warn "could not file *list";
chomp; chomp;
# better check if /. is missing in any of the *list # better check if /. is missing in any of the *list
my $count = 0; my $count = 0;
my @count = <LIST>; my @count = <LIST>;
close(LIST); close(LIST);
foreach (@count) { foreach (@count) {
$x = 1 if $x == 6; $x = 1 if $x == 6;
print STDERR "|\r" if $x == 1 || $x == 4; print STDERR "/\r" if $x == 2; print STDERR "|\r" if $x == 1 || $x == 4; print STDERR "/\r" if $x == 2;
print STDERR "-\r" if $x == 3 || $x == 6; print STDERR "\\\r" if $x == 5; print STDERR "-\r" if $x == 3 || $x == 6; print STDERR "\\\r" if $x == 5;
$x++; $x++;
chomp $_; chomp $_;
# does /. exist? it should be first. # does /. exist? it should be first.
if ($count == 0) { if ($count == 0) {
if ($_ !~ m,\/\.,) { if ($_ !~ m,\/\.,) {
my $shifter = $_; my $shifter = $_;
my @redolist = @count; my @redolist = @count;
push(@count,$shifter); push(@count,$shifter);
# humm let's rebuild the offending backup list, this # humm let's rebuild the offending backup list, this
# is important for --db. # is important for --db.
unshift(@redolist,"/."); unshift(@redolist,"/.");
open(REDOLIST, ">$ARGV[2]/$ARGV[0]/backup/$the[0].list.bk.bk") open(REDOLIST, ">$ARGV[2]/$ARGV[0]/backup/$the[0].list.bk.bk")
or warn "needed to edit $the[0].list because it lacked /., or warn "needed to edit $the[0].list because it lacked /.,
but could not open up a backup file\n"; but could not open up a backup file\n";
my $rd; my $rd;
foreach $rd (@redolist) { foreach $rd (@redolist) {
chomp $rd; chomp $rd;
print REDOLIST "$rd\n"; print REDOLIST "$rd\n";
} }
close(REDOLIST); close(REDOLIST);
rename("$ARGV[2]/$ARGV[0]/backup/$the[0].list.bk.bk", rename("$ARGV[2]/$ARGV[0]/backup/$the[0].list.bk.bk",
"$ARGV[2]/$ARGV[0]/backup/$the[0].list.bk"); "$ARGV[2]/$ARGV[0]/backup/$the[0].list.bk");
$_ = "/."; $_ = "/.";
} }
} }
$count = 1; $count = 1;
print FILEDIR "$_ -> $the[0]_$the[1]\n"; print FILEDIR "$_ -> $the[0]_$the[1]\n";
} # foreach @count } # if *list exists
} # while TRANSFER } # foreach @count
close(TRANSFER); } # while TRANSFER
close(FILEDIR); close(TRANSFER);
} # else close(FILEDIR);
} # else

Loading…
Cancel
Save