mirror of https://github.com/fspc/dswim
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
270 lines
8.9 KiB
270 lines
8.9 KiB
# Package administration and research tool for Debian
|
|
# Copyright (C) 1999-2001 Jonathan D. 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 (<PARTS>) {
|
|
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";
|
|
}
|
|
|
|
# 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 (<PARTS>) {
|
|
@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 (<PARTS>) {
|
|
@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;
|
|
|