# Debian System Wide Information Manager # Copyright (C) 1998-2005 Jonathan Rosenbaum # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. package SWIM::MD; use strict; use SWIM::Conf qw(:Path $splt); use SWIM::DB_Library qw(:Md); use SWIM::Library; use SWIM::Global; use vars qw(@ISA @EXPORT %EXPORT_TAGS); use Exporter; @ISA = qw(Exporter); @EXPORT = qw(process_md); # process_md used by both SWIM::DB_Init and SWIM::NDB_Init =pod Because many files and directories exist more than once, and it would be kind of cool to go up to a directory /usr/bin or /usr/bin/ and do a swim -qf and see all the packages that populate that directory... multi-dimensional is the way to go. =cut sub process_md { print STDERR "File Database is being made\n"; my ($commands) = @_; my %commands = %$commands; my @ppackage; my %md; my @md; my @mi; my $thingy; my @name; my $count = 0; my $count1 = 1; my($place) = finddb(\%commands); #$place = "$default_directory$place"; # Let's determine what architecture and distribution this person is # interested in. my ($arch, $dist, $not); if ($commands->{"initndb"} || $commands->{"rebuildndb"}) { ($arch,$dist) = which_archdist(\%commands); $not = "n"; } else { $arch = ""; $dist = ""; $not = ""; } my $fileindex = $not . "fileindex"; # Now we process the files made from the massive array, and create # fileindex.deb or nfileindex.deb # Let's just use split, and will allow for customized line adj. # 25000 is the default if ($commands->{"split_data"}) { my $split = $commands->{"split_data"}; system("$splt -l $split $tmp/big.debian $tmp/DEBIAN"); } else { # Seems like a good default system("$splt -l 25000 $tmp/big.debian $tmp/DEBIAN"); } @ppackage = <$tmp/DEBIAN*>; # It's unlikely this file will ever get too massive. push(@ppackage, "$tmp/long.debian"); print STDERR " Create the database\n"; foreach $thingy (@ppackage) { open(PARTS, "$thingy"); while () { my @c; @md = split(/ -> /,$_); if (defined($md[1])) { chomp $md[0]; chomp $md[1]; @c = split(/\s/, $md[1]); } push(@mi,$md[0]); push(@mi,$md[1]); } # while print STDERR " $thingy\n"; print STDERR " wait a few seconds\n"; my $zing; if (($commands->{"dbpath"} && $commands->{"root"}) || ($commands->{"dbpath"} && !$commands->{"root"}) || (!$commands->{"dbpath"} && !$commands->{"root"})) { $zing = tie %md, 'DB_File',"$default_directory$parent$library/$fileindex$arch$dist.deb" or die "DB_File: $!"; } elsif (!$commands->{"dbpath"} && $commands->{"root"}) { $zing = tie %md, 'DB_File',"$default_directory$parent$base/$fileindex$arch$dist.deb" or die "DB_File: $!"; } while ($count <= $#mi) { $zing->put($mi[$count], $mi[$count1]); $count = $count + 2; $count1 = $count1 + 2; } undef $zing; untie %md; undef %md; @mi = (); @md = (); $count = 0; $count1 = 1; close(PARTS); } # end foreach # now we get to take into account deinstall:ok:config-files # situations for an installed system. if ($commands->{"initdb"} || $commands->{"rebuilddb"}) { sb(\%$commands); ib(\%commands); my $yich; foreach (values %sb) { my $zit; my ($nit,$yit) = (split(/\s/,$_))[0,3]; if ($yit eq "deinstall:ok:config-files" || $yit eq "purge:ok:config-files") { ($zit = $nit) =~ s,\+,\\\+,; if ($ib{"/."} !~ m,$zit,) { if (!defined $yich) { $yich = $nit; } else { $yich = $yich . " $nit"; } } } } $ib{"/."} = $ib{"/."} . " $yich" if defined $ib{"/."} && $yich; } # after much experimentation it turns out that a flat text file # is much faster for this particular application. This also # creates the hash database reference for -db or -i. my $searchindex = $not . "searchindex"; open(FLATFILE, ">$place/$searchindex$arch$dist.deb"); print STDERR "Create the powersearch flat database\n"; foreach $thingy (@ppackage) { if ($thingy ne "$tmp/long.debian") { open(PARTS, "$thingy"); while () { @md = split(/ -> /,$_); if (defined($md[1])) { chomp $md[0]; } push(@mi,$md[0]); } # while } print STDERR " $thingy\n"; print STDERR " wait a few seconds\n"; while ($count <= $#mi) { print FLATFILE "$mi[$count]\n"; $count++; } $count = 0; @mi = (); @md = (); close(PARTS); } # end foreach close(FLATFILE); # This creates the flatfile with the directories for --powersearch # --dir, which is probably a rare match in most cases. This doesn't # create a hash reference database for --db and -i because the only # package which could benifit from this is base-files, but it has # configuaration files, on the other hand RedHat has at least one # package without directories or files, but this is Debian. my $dirindex = $not . "dirindex"; open(FLATFILE, ">$place/$dirindex$arch$dist.deb"); print STDERR "Create the powersearch flat directory database\n"; open(PARTS, "$ppackage[$#ppackage]"); while () { @md = split(/ -> /,$_); if (defined($md[1])) { chomp $md[0]; } push(@mi,$md[0]); } # while print STDERR " $ppackage[$#ppackage]\n"; while ($count <= $#mi) { print FLATFILE "$mi[$count]\n"; $count++; } $count = 0; @mi = (); @md = (); close(PARTS); close(FLATFILE); # compare nstatusindex*.deb to /. from nfileindex*.deb to find out if # any of the packages in Packages weren't represented in the Contents # file. This is different than the earlier report which shows packages # which weren't in Packages but were in Contents. This list is kept, # and used again in a future --ndb run to make the matches, if they # exist. if ($commands->{"initndb"} || $commands->{"rebuildndb"}) { nsb(\%$commands); nzing(\%commands); my @fileindex = split(/\s/,$ib{"/."}); my @statusindex = split(/\s/,$nsb{"/."}); if ($#fileindex < $#statusindex) { my $place = finddb(\%commands); $place = "$default_directory$place"; open(DIFF, ">$place/.packagesdiff$arch$dist.deb") or warn "couldn't create diff file\n"; my %uniques; @uniques{@fileindex} = (); foreach (@statusindex) { # no sense putting non-US or experimental in here unless this # is what is wanted. Only need to check for group non-us/* if (!$commands->{"nue"}) { my $name = (split(/_/,$_))[0]; if (defined $nsb{$name}) { next if (split(/\s/,$nsb{$name}))[1] =~ m,non-us,; } if ($dist eq "experimental") { next; } } elsif ($dist eq "experimental") { if (!$commands->{"nue"}) { my $name = (split(/_/,$_))[0]; if (defined $nsb{$name}) { next if (split(/\s/,$nsb{$name}))[1] =~ m,non-us,; } } } print DIFF "$_\n" unless exists $uniques{$_}; } $zing->del("/."); $zing->put("/.",$nsb{"/."}); } } # end if # Will unlink transfer.deb, big.debian, long.debian. unlink(<$tmp/DEBIAN*>); unlink("$tmp/transfer.deb"); unlink("$tmp/big.debian"); unlink("$tmp/long.debian"); #!!! print STDERR " over and out\n"; print STDERR scalar(localtime), "\n"; } # end sub process_md 1;