Browse Source

Fixed an introduced bug when fixing --purge .. now if can just get

virtual listing working properl again.
master
freesource 20 years ago
parent
commit
764c7fc2cb
  1. 121
      SWIM/DB.pm

121
SWIM/DB.pm

@ -71,6 +71,7 @@ sub db {
my (@GONE, @CHANGED, @NEW); my (@GONE, @CHANGED, @NEW);
my @before; my @before;
my %compare; my %compare;
my %purge_count;
# The mys for NEW # The mys for NEW
my $count = 0; my $count = 0;
@ -103,7 +104,7 @@ sub db {
if (/^Package:/i) { if (/^Package:/i) {
@package = split(/: /,$_); @package = split(/: /,$_);
chomp $package[1]; chomp $package[1];
} }
elsif (/^Status:/) { elsif (/^Status:/) {
chomp; chomp;
$status = substr($_,8); $status = substr($_,8);
@ -112,10 +113,21 @@ sub db {
########## ##########
# PURGED # # PURGED #
########## ##########
# actually this works correctly if the db was pre-made
# because $rootsky was being appende, so the same thing will
# be done for --db now :)
if (defined $db{$package[1]}) { if (defined $db{$package[1]}) {
#print "$db{$package[1]}\n"; #print "$db{$package[1]}\n";
$db{$package[1]} =~ m,(^.*)_.*$,; #$db{$package[1]} =~ m,(^.*)_.*$,;
push(@GONE,$1); #$purge_count{$1}++;
# print "HI $1 $purge_count{$1}\n";
#my $it = grep(/$1/,@GONE);
#print "HELLO $it\n";
#if ($purge_count{$1} == 1 ) {
#if ( !grep(/$1/,@GONE) ) {
# push(@GONE,$1);
#}
#}
} }
} }
} }
@ -213,7 +225,7 @@ sub db {
return 1; return 1;
} }
print STDERR "\n TOTAL\n -----\n"; print STDERR "\n TOTAL\n -----\n";
print STDERR "NEW $new\n"; print "GONE $gon\n"; print STDERR "NEW $new\n"; print "GONE $gon\n";
print STDERR "CHANGED $ch\n"; print "CHANGED STATUS $cr\n"; print STDERR "CHANGED $ch\n"; print "CHANGED STATUS $cr\n";
@ -422,9 +434,11 @@ sub db {
my %exacts; my %exacts;
my $goon; my $goon;
print STDERR "\n" if $#NEW != -1; $x = 1; print STDERR "\n" if $#NEW != -1; $x = 1;
foreach (@NEW) { foreach (@NEW) {
$exacts{$_} = "yes"; $exacts{$_} = "yes";
} }
# first let's find the fields to put into packages.deb # first let's find the fields to put into packages.deb
# We'll have to go through the status file again, something we # We'll have to go through the status file again, something we
# wouldn't have had to do with swim -i. As it turns out, a good # wouldn't have had to do with swim -i. As it turns out, a good
@ -809,9 +823,9 @@ sub db {
print STDERR "\n" if $#NEW != -1; $x = 1; print STDERR "\n" if $#NEW != -1; $x = 1;
foreach $package_name (@NEW) { foreach $package_name (@NEW) {
open(FILENAME,"$main::home$parent$base/info/$package_name.list"); open(FILENAME,"$parent$base/info/$package_name.list");
open(CP,">$main::home$parent$base/info/backup/$package_name.list.bk"); open(CP,">$main::home$parent$base/info/backup/$package_name.list.bk");
if ( -e "$main::home$parent$base/info/$package_name.list" ) { if ( -e "$parent$base/info/$package_name.list" ) {
while (<FILENAME>) { while (<FILENAME>) {
print CP $_; print CP $_;
} }
@ -826,50 +840,55 @@ sub db {
while (<LIST>) { while (<LIST>) {
chomp; chomp;
# Better add the new stuff to the flat files first # Better add the new stuff to the flat files first
if (!defined $ib{$_}) { if (!defined $ib{$_}) {
if (($commands->{"dbpath"} && $commands->{"root"}) || if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) || ($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) { (!$commands->{"dbpath"} && !$commands->{"root"})) {
open(SEARCHINDEX,">>$main::home$parent$library/searchindex.deb"); open(SEARCHINDEX,">>$main::home$parent$library/searchindex.deb");
} }
elsif (!$commands->{"dbpath"} && $commands->{"root"}) { elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
open(SEARCHINDEX,">>$main::home$parent$base/searchindex.deb"); open(SEARCHINDEX,">>$main::home$parent$base/searchindex.deb");
} }
if (!-d) { if (!-d) {
print SEARCHINDEX "$_\n"; print SEARCHINDEX "$_\n";
} }
if (($commands->{"dbpath"} && $commands->{"root"}) || if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) || ($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) { (!$commands->{"dbpath"} && !$commands->{"root"})) {
open(DIRINDEX,">>$main::home$parent$library/dirindex.deb"); open(DIRINDEX,">>$main::home$parent$library/dirindex.deb");
} }
elsif (!$commands->{"dbpath"} && $commands->{"root"}) { elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
open(DIRINDEX,">>$main::home$parent$base/dirindex.deb"); open(DIRINDEX,">>$main::home$parent$base/dirindex.deb");
} }
if (-d) { if (-d) {
print DIRINDEX "$_\n"; print DIRINDEX "$_\n";
} }
} # !defined } # !defined
# If the directory already exists we can just append
# to the end of the value
if (defined $ib{$_}) {
dbi(\%commands);
my $cvalue = $ib{$_} . " $db{$package_name}";
# put overwrites by default!
$zing->put($_,$cvalue);
} # if defined
else {
dbi(\%commands);
print "$_ $db{$package_name}\n";
$zing->put($_,$db{$package_name});
}
# If the directory already exists we can just append untie %db;
# to the end of the value untie $zing;
if (defined $ib{$_}) {
dbi(\%commands); } # end while
my $cvalue = $ib{$_} . " $db{$package_name}";
# put overwrites by default!
$zing->put($_,$cvalue); close(LIST);
} # if defined close(SEARCHINDEX);
else { close(DIRINDEX);
dbi(\%commands);
$zing->put($_,$db{$package_name});
}
untie %db;
untie $zing;
}
close(LIST);
close(SEARCHINDEX);
close(DIRINDEX);
my $zit; my ($nit,$yit) = (split(/\s/,$sb{$package_name}))[0,3]; my $zit; my ($nit,$yit) = (split(/\s/,$sb{$package_name}))[0,3];
if ($yit eq "deinstall:ok:config-files" || if ($yit eq "deinstall:ok:config-files" ||

Loading…
Cancel
Save