Debian System Wide Information Manager
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.

176 lines
6.6 KiB

#!/usr/bin/perl -w
require 5.004;
use strict;
############################################################################
#
# 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
#
#############################################################################
# Because it is a better to write to disk, rather than trying to do
# everthing in memory, and then it's good to close the process which
# accomplished this. I am sure there are better ways.
# Anyways if you want to test fastswim do something like this:
# fastswim --transfer /var/lib/dpkg/info /tmp /var/lib/dpkg and create a
# transfer.deb file beforehand in /tmp which has the packagename_version
# one to a line.
my @ppackage;
my %repeaters;
my $thingy;
my $tingy;
my $temp;
my %HL;
my @name;
my %version;
#$| = 1;
#$#name = 2000;
#$#ppackage = 2000;
# This way has been de-pre-c-whatever-ated because it lacks version
# rememberance, and is just kept for testing purposes
if ($#ARGV == -1) {
print STDERR "swim: fastswim requires option/arguments, see program for instructions\n";
exit;
chdir("$ARGV[1]");
#consider readdir
@ppackage = <*.list>;
}
# This does the work
elsif ($ARGV[0] eq "--transfer") {
open(TRANSFER, "$ARGV[2]/transfer.deb");
while (<TRANSFER>) {
chomp $_;
if (defined $_) {
my @the = split(/_/, $_);
push(@ppackage, "$the[0].list");
# remember the version.
chomp $the[1];
$version{$the[0]} = $the[1];
}
}
close(TRANSFER);
}
# Make a nice md. I decided on a Hash of Lists, giving all
# files/dirs unique name, and then a list of packages which
# correspond..because this should be faster than a Hash of Hash
# where you'd have to loop through all packages names..find the
# files/dir in all packages names which are the same..I'd assume a HL
# would be a quicker query, even though the Hash would be enormous.
# Possible things: a tree for faster query.
# Put everything into an array..every other is package name
# Better check for packages which don't have /. in their *.list...
# which is rare, but does happen. Sometimes *.list(s) don't have
# all the parent directories, but we won't worry about that.
print STDERR " Making the massive hash\n";
$| = 1; my $x = 1;
foreach $thingy (sort @ppackage) {
open(LIST, "$ARGV[1]/$thingy") or die "Humm, strange";
# Because of the version..there are sometimes dots
$thingy =~ m,(.*)\.list,;
my $count = 0;
my @count = <LIST>;
close(LIST);
foreach (@count) {
$x = 1 if $x == 6;
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;
$x++;
chomp $_;
# does /. exist? it should be first.
if ($count == 0) {
if ($_ !~ m,\/\.,) {
my $shifter = $_;
my @redolist = @count;
push(@count,$shifter);
# humm let's rebuild the offending backup list, this
# is important for --db.
unshift(@redolist,"/.");
open(REDOLIST, ">$ARGV[3]/$ARGV[1]/backup/$thingy.bk.bk")
or warn "needed to edit $thingy because it lacked /.,
but could not open up a backup file
$ARGV[3]/$ARGV[1]/backup/$thingy.bk.bk\n";
my $rd;
foreach $rd (@redolist) {
chomp $rd;
print REDOLIST "$rd\n";
}
close(REDOLIST);
rename
("$ARGV[3]/$ARGV[1]/backup/$thingy.bk.bk","$ARGV[3]/$ARGV[1]/backup/$thingy.bk");
$_ = "/.";
}
}
$count = 1;
$repeaters{$_}++;
if ($repeaters{$_} == 1) {
$temp = 0;
}
else {
$temp = $repeaters{$_} - 1;
}
if (defined $version{$1}) {
$HL{$_}[$temp] = "$1_$version{$1}";
}
}
}
undef @ppackage;
# We will create one file with the 1..and another with >1..
# than split..reverse..and order.accordingly..this makes
# things much faster. Remember clean-up routines for kill.
print STDERR " Starting ... writing to $ARGV[2]!\n";
# Create the database
open(BIG, ">$ARGV[2]/big.debian") or die;
open(LONG, ">$ARGV[2]/long.debian") or die;
foreach $thingy (sort keys %HL ) {
$x = 1 if $x == 6;
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;
$x++;
# Humm, will split or grep be faster?
#my $tingy = "@{ $HL{$thingy} }" . " " . @{ $HL{$thingy} };
my $tingy = "@{ $HL{$thingy} }";
if (@{ $HL{$thingy} } > 1 || @{ $HL{$thingy} } eq "") {
print LONG "$thingy -> $tingy\n";
}
elsif (@{ $HL{$thingy} } == 1) {
print BIG "$thingy -> $tingy\n";
}
}
#print "Finished\n";
close(BIG);
close(LONG);
#undef %HL;
print STDERR " Cleaning up\n";
__END__