mirror of
https://github.com/fspc/dswim.git
synced 2026-09-16 08:31:39 -04:00
*** empty log message ***
This commit is contained in:
freesource
Executable
+167
@@ -0,0 +1,167 @@
|
||||
#!/usr/bin/perl -w
|
||||
#use diagnostics;
|
||||
require 5.004;
|
||||
use strict;
|
||||
|
||||
################################################################################
|
||||
# Package administration and research tool for Debian #
|
||||
# Copyright (C) 1999-2000 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 "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 " 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 "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
|
||||
print "-\r" if $x == 3 || $x == 6; print "\\\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[1]/backup/$thingy.bk.bk")
|
||||
or warn "needed to edit $thingy because it lacked /.,
|
||||
but could not open up a backup file\n";
|
||||
my $rd;
|
||||
foreach $rd (@redolist) {
|
||||
chomp $rd;
|
||||
print REDOLIST "$rd\n";
|
||||
}
|
||||
close(REDOLIST);
|
||||
rename
|
||||
("$ARGV[1]/backup/$thingy.bk.bk","$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 " 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 "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
|
||||
print "-\r" if $x == 3 || $x == 6; print "\\\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 " Cleaning up\n";
|
||||
|
||||
__END__
|
||||
Executable
+99
@@ -0,0 +1,99 @@
|
||||
#!/usr/bin/perl -w
|
||||
#use diagnostics;
|
||||
require 5.004;
|
||||
use strict;
|
||||
|
||||
################################################################################
|
||||
# Package administration and research tool for Debian #
|
||||
# Copyright (C) 1999-2000 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.#
|
||||
################################################################################
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
This allows computers with a small amount of memory or overloaded system
|
||||
to succeed in making the databases for SWIM::DB_Init. Instead of using
|
||||
transfer.deb to grab everything into memory and then creating the
|
||||
long.debian and big.debian files right out of memory for processing by
|
||||
SWIM::MD, it works like longswim by creating one large file to the disk
|
||||
(this can use lots of memory, but can swap easily) then it uses slowswim
|
||||
to create long.debian and big.debian using a minimal memory method, then
|
||||
it finishes using SWIM::MD.
|
||||
|
||||
To test supply these arguments - info dir, temporary dir "imswim
|
||||
/var/lib/dpkg/info /tmp" and create a transfer.deb file
|
||||
beforehand in the temporary dir which has the packagename_version one to a
|
||||
line.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
if ($#ARGV == -1) {
|
||||
print "swim: imswim requires arguments, see program for instructions\n";
|
||||
exit;
|
||||
}
|
||||
else {
|
||||
$| = 1; my $x = 1;
|
||||
open(FILEDIR, ">$ARGV[1]/filedir.deb")
|
||||
or warn "could not create filedir.deb\n";
|
||||
open(TRANSFER, "$ARGV[1]/transfer.deb") or warn "needs transfer.deb";
|
||||
while (<TRANSFER>) {
|
||||
chomp;
|
||||
my @the = split(/_/, $_);
|
||||
open (LIST, "$ARGV[0]/$the[0].list")
|
||||
or warn "could not file *list";
|
||||
chomp;
|
||||
# better check if /. is missing in any of the *list
|
||||
my $count = 0;
|
||||
my @count = <LIST>;
|
||||
close(LIST);
|
||||
foreach (@count) {
|
||||
$x = 1 if $x == 6;
|
||||
print "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
|
||||
print "-\r" if $x == 3 || $x == 6; print "\\\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[0]/backup/$the[0].list.bk.bk")
|
||||
or warn "needed to edit $the[0].list because it lacked /.,
|
||||
but could not open up a backup file\n";
|
||||
my $rd;
|
||||
foreach $rd (@redolist) {
|
||||
chomp $rd;
|
||||
print REDOLIST "$rd\n";
|
||||
}
|
||||
close(REDOLIST);
|
||||
rename("$ARGV[0]/backup/$the[0].list.bk.bk",
|
||||
"$ARGV[0]/backup/$the[0].list.bk");
|
||||
$_ = "/.";
|
||||
}
|
||||
}
|
||||
$count = 1;
|
||||
print FILEDIR "$_ -> $the[0]_$the[1]\n";
|
||||
} # foreach @count
|
||||
} # while TRANSFER
|
||||
close(TRANSFER);
|
||||
close(FILEDIR);
|
||||
} # else
|
||||
Executable
+591
@@ -0,0 +1,591 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
#use diagnostics;
|
||||
use strict;
|
||||
use DB_File;
|
||||
|
||||
################################################################################
|
||||
# Package administration and research tool for Debian #
|
||||
# Copyright (C) 1999-2000 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.#
|
||||
################################################################################
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
This program creates the file filedir.deb using choice() and
|
||||
comma_choice() (which both use timing() in case Contents is newer than
|
||||
Packages). It establishes the file based on --main, --contrib, --non-free,
|
||||
--non-us or the default. This program is quite time consuming and uses
|
||||
more and more memory as it runs. Afterwared, the output can be processed
|
||||
by fastswim (high memory approach) or slowswim (low memory approach),
|
||||
whether either is faster is still subject to experimentation. swim packs
|
||||
everything into the databases. It also produces the report
|
||||
.contentsdiff-arch-dists.deb which shows which packages exist in Contents
|
||||
which don't exist in Packages.
|
||||
|
||||
This program takes a large amount of arguments. Look at nmd() in
|
||||
SWIM::NDB_Init.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
if ($#ARGV == -1) {
|
||||
print "swim: longswim requires many arguments, see program for instructions\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my $Contents;
|
||||
my $contentsindex;
|
||||
my ($main,$contrib,$non_free,$non_us);
|
||||
my $tmp;
|
||||
my (%watch,%ndb);
|
||||
my $npackages;
|
||||
my $gzip;
|
||||
my $place;
|
||||
|
||||
# process @ARGV
|
||||
$Contents = $ARGV[0]; $contentsindex = $ARGV[1];
|
||||
$main = $ARGV[2]; $contrib = $ARGV[3];
|
||||
$non_free = $ARGV[4]; $non_us = $ARGV[5];
|
||||
$tmp = $ARGV[6];
|
||||
$npackages = $ARGV[7];
|
||||
$gzip = $ARGV[8];
|
||||
$place = $ARGV[9];
|
||||
my $Contents_mtime = $ARGV[10];
|
||||
|
||||
# tie it once not a quarter million times
|
||||
tie %ndb, 'DB_File', "$npackages" or die "DB_File: $!";
|
||||
|
||||
# Let's find the arch and dists
|
||||
my @archdist = split(m,/,,$contentsindex);
|
||||
my($arch,$dist) = (split(m,-,,$archdist[$#archdist]))[1,2];
|
||||
$dist =~ s,\.deb,,;
|
||||
|
||||
unlink("$place/.contentsdiff-$arch-$dist.deb")
|
||||
if -e "$place/.contentsdiff-$arch-$dist.deb";
|
||||
|
||||
nmd();
|
||||
|
||||
# main processing program
|
||||
sub nmd {
|
||||
|
||||
my %again;
|
||||
my %all;
|
||||
|
||||
$| = 1; my $x = 1;
|
||||
open(CONTENTS, "$Contents") or die "where is it?\n";
|
||||
open(FILEDIR,">$tmp/filedir.deb");
|
||||
open(CONTENTSDB,">$contentsindex");
|
||||
while (<CONTENTS>) {
|
||||
print CONTENTSDB $_;
|
||||
if (/^FILE\s*LOCATION$/) {
|
||||
while (<CONTENTS>) {
|
||||
s,^(\./)+,,; # filter for Debians altered dir structure
|
||||
print CONTENTSDB $_;
|
||||
$x = 1 if $x == 6;
|
||||
print "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
|
||||
print "-\r" if $x == 3 || $x == 6; print "\\\r" if $x == 5;
|
||||
$x++;
|
||||
chomp $_;
|
||||
# find all directories
|
||||
# split is the way to go.
|
||||
# If it ends with / its a directory
|
||||
my($dirfile,$package,@packs,@dirfile,@package,@comma);
|
||||
|
||||
|
||||
######################
|
||||
# ENDS WITH / #
|
||||
######################
|
||||
if (m,.*/\s+\w*,) {
|
||||
($dirfile,$package) = split(/\s+/,$_,2);
|
||||
if ($package !~ m,^[a-z0-9-]*/.*$|^[a-z0-9-]*/.*/.*$,) {
|
||||
my @more_things = split(/\s+/,$package);
|
||||
$package = $more_things[$#more_things];
|
||||
(my $backpackage = $package) =~ s,\+,\\+,g;
|
||||
my @dirfile = split(/\s+$backpackage/,$_);
|
||||
$dirfile = $dirfile[0];
|
||||
}
|
||||
@dirfile = split(/\//,$dirfile); $dirfile =~ s,/$,,;
|
||||
@comma = split(/,/,$package);
|
||||
|
||||
#################
|
||||
# HAS A COMMA #
|
||||
#################
|
||||
if (scalar(@comma) >= 2) {
|
||||
# humm many packages share this file/dir
|
||||
my @choice_package;
|
||||
##########
|
||||
## MAIN ##
|
||||
##########
|
||||
if ($main eq "yes") {
|
||||
foreach (@comma) {
|
||||
if (defined $_) {
|
||||
if ($_ !~ m,^non-free/|^contrib/|^non-us/,) {
|
||||
push(@choice_package,$_);
|
||||
}
|
||||
}
|
||||
}
|
||||
@packs = comma_choice(@choice_package);
|
||||
} # choice in main
|
||||
############
|
||||
##NON-FREE##
|
||||
############
|
||||
if ($non_free eq "yes") {
|
||||
foreach (@comma) {
|
||||
if (m,^non-free/,) {
|
||||
push(@choice_package,$_);
|
||||
}
|
||||
}
|
||||
@packs = comma_choice(@choice_package);
|
||||
} # choice non-free
|
||||
###########
|
||||
##CONTRIB##
|
||||
###########
|
||||
if ($contrib eq "yes") {
|
||||
foreach (@comma) {
|
||||
if (m,^contrib/,) {
|
||||
push(@choice_package,$_);
|
||||
}
|
||||
}
|
||||
@packs = comma_choice(@choice_package);
|
||||
} # choice contrib
|
||||
#########
|
||||
#NON-US##
|
||||
#########
|
||||
if ($non_us eq "yes") {
|
||||
foreach (@comma) {
|
||||
if (m,^non-us/,) {
|
||||
push(@choice_package,$_);
|
||||
}
|
||||
}
|
||||
@packs = comma_choice(@choice_package);
|
||||
} # choice non-us
|
||||
|
||||
} # scalar @comma >= 2
|
||||
|
||||
# When only one package exists for dir
|
||||
#############
|
||||
##############
|
||||
# NO COMMA #
|
||||
##############
|
||||
elsif (scalar(@comma) == 1) {
|
||||
my $choice_package;
|
||||
##########
|
||||
## MAIN ##
|
||||
##########
|
||||
if ($main eq "yes") {
|
||||
# only one package found related to choice section
|
||||
if (defined $package) {
|
||||
if ($package !~ m,^non-free/|^contrib/|^non-us/,) {
|
||||
$choice_package = $package;
|
||||
@package = split(/\//,$choice_package);
|
||||
}
|
||||
}
|
||||
@packs = choice(@package);
|
||||
} # end choice main
|
||||
|
||||
############
|
||||
##NON-FREE##
|
||||
############
|
||||
if ($non_free eq "yes") {
|
||||
if (defined $package) {
|
||||
if ($package =~ m,^non-free/,) {
|
||||
$choice_package = $package;
|
||||
@package = split(/\//,$choice_package);
|
||||
}
|
||||
}
|
||||
@packs = choice(@package);
|
||||
} # end choice main
|
||||
|
||||
###########
|
||||
##CONTRIB##
|
||||
###########
|
||||
if ($contrib eq "yes") {
|
||||
if (defined $package) {
|
||||
if ($package =~ m,^contrib/,) {
|
||||
$choice_package = $package;
|
||||
@package = split(/\//,$choice_package);
|
||||
}
|
||||
}
|
||||
@packs = choice(@package);
|
||||
} # end choice main
|
||||
|
||||
#########
|
||||
#NON-US##
|
||||
#########
|
||||
if ($non_us eq "yes") {
|
||||
if (defined $package) {
|
||||
if ($package =~ m,^non-us/,) {
|
||||
$choice_package = $package;
|
||||
@package = split(/\//,$choice_package);
|
||||
}
|
||||
}
|
||||
@packs = choice(@package);
|
||||
} # end choice main
|
||||
|
||||
|
||||
} # @comma = 1
|
||||
|
||||
#################
|
||||
# WRITE TO FILE #
|
||||
#################
|
||||
foreach $package (@packs) {
|
||||
my ($count,$holder);
|
||||
for ($count = 0; $count <= $#dirfile; $count++) {
|
||||
if ($count == 0) {
|
||||
$holder = "/$dirfile[$count]";
|
||||
my $again = "$dirfile[$count] -> $package";
|
||||
my $all = "/. -> $package";
|
||||
$again{$again}++;
|
||||
$all{$all}++;
|
||||
if ($all{$all} == 1) {
|
||||
print FILEDIR "/. -> $package\n";
|
||||
##repeaters("/.",$package);
|
||||
}
|
||||
if ($again{$again} == 1) {
|
||||
print FILEDIR "/$dirfile[$count] -> $package\n";
|
||||
##repeaters("/$dirfile[$count]",$package);
|
||||
}
|
||||
}
|
||||
else {
|
||||
$holder = $holder . "/$dirfile[$count]";
|
||||
#print "$holder -> $package\n";
|
||||
#repeaters($holder,$package);
|
||||
my $again = "$holder -> $package";
|
||||
$again{$again}++;
|
||||
if ($again{$again} == 1) {
|
||||
print FILEDIR "$holder -> $package\n";
|
||||
##repeaters($holder,$package);
|
||||
}
|
||||
}
|
||||
} # end for
|
||||
}
|
||||
} # does end with /
|
||||
|
||||
######################
|
||||
# DOESN'T END WITH / #
|
||||
######################
|
||||
# find all files and directories
|
||||
else {
|
||||
($dirfile,$package) = split(/\s+/,$_,2);
|
||||
if ($package !~ m,^[a-z0-9-]*/.*$|^[a-z0-9-]*/.*/.*$,) {
|
||||
my @more_things = split(/\s+/,$package);
|
||||
$package = $more_things[$#more_things];
|
||||
(my $backpackage = $package) =~ s,\+,\\+,g;
|
||||
# watch this
|
||||
my @dirfile = split(/\s+$backpackage/,$_);
|
||||
$dirfile = $dirfile[0];
|
||||
}
|
||||
@dirfile = split(/\//,$dirfile);
|
||||
@comma = split(/,/,$package);
|
||||
|
||||
#################
|
||||
# HAS A COMMA #
|
||||
#################
|
||||
if (scalar(@comma) >= 2) {
|
||||
# humm many packages share this file/dir
|
||||
my @choice_package;
|
||||
##########
|
||||
## MAIN ##
|
||||
##########
|
||||
if ($main eq "yes") {
|
||||
foreach (@comma) {
|
||||
if (defined $_) {
|
||||
if ($_ !~ m,^non-free/|^contrib/|^non-us/,) {
|
||||
push(@choice_package,$_);
|
||||
}
|
||||
}
|
||||
}
|
||||
@packs = comma_choice(@choice_package);
|
||||
} # choice in main
|
||||
############
|
||||
##NON-FREE##
|
||||
############
|
||||
if ($non_free eq "yes") {
|
||||
foreach (@comma) {
|
||||
if (m,^non-free/,) {
|
||||
push(@choice_package,$_);
|
||||
}
|
||||
}
|
||||
@packs = comma_choice(@choice_package);
|
||||
} # choice non-free
|
||||
###########
|
||||
##CONTRIB##
|
||||
###########
|
||||
if ($contrib eq "yes") {
|
||||
foreach (@comma) {
|
||||
if (m,^contrib/,) {
|
||||
push(@choice_package,$_);
|
||||
}
|
||||
}
|
||||
@packs = comma_choice(@choice_package);
|
||||
} # choice contrib
|
||||
#########
|
||||
#NON-US##
|
||||
#########
|
||||
if ($non_us eq "yes") {
|
||||
foreach (@comma) {
|
||||
if (m,^non-us/,) {
|
||||
push(@choice_package,$_);
|
||||
}
|
||||
}
|
||||
@packs = comma_choice(@choice_package);
|
||||
} # choice non-us
|
||||
|
||||
} # scalar @comma == 2
|
||||
|
||||
# When only one package exists for file
|
||||
#############
|
||||
##############
|
||||
# NO COMMA #
|
||||
##############
|
||||
elsif (scalar(@comma) == 1) {
|
||||
my $choice_package;
|
||||
##########
|
||||
## MAIN ##
|
||||
##########
|
||||
if ($main eq "yes") {
|
||||
# only one package found related to choice section
|
||||
if (defined $package) {
|
||||
if ($package !~ m,^non-free/|^contrib/|^non-us/,) {
|
||||
$choice_package = $package;
|
||||
@package = split(/\//,$choice_package);
|
||||
}
|
||||
}
|
||||
@packs = choice(@package);
|
||||
} # end choice main
|
||||
|
||||
############
|
||||
##NON-FREE##
|
||||
############
|
||||
if ($non_free eq "yes") {
|
||||
if (defined $package) {
|
||||
if ($package =~ m,^non-free/,) {
|
||||
$choice_package = $package;
|
||||
@package = split(/\//,$choice_package);
|
||||
}
|
||||
}
|
||||
@packs = choice(@package);
|
||||
} # end choice main
|
||||
|
||||
###########
|
||||
##CONTRIB##
|
||||
###########
|
||||
if ($contrib eq "yes") {
|
||||
if (defined $package) {
|
||||
if ($package =~ m,^contrib/,) {
|
||||
$choice_package = $package;
|
||||
@package = split(/\//,$choice_package);
|
||||
}
|
||||
}
|
||||
@packs = choice(@package);
|
||||
} # end choice main
|
||||
|
||||
#########
|
||||
#NON-US##
|
||||
#########
|
||||
if ($non_us eq "yes") {
|
||||
if (defined $package) {
|
||||
if ($package =~ m,^non-us/,) {
|
||||
$choice_package = $package;
|
||||
@package = split(/\//,$choice_package);
|
||||
}
|
||||
}
|
||||
@packs = choice(@package);
|
||||
} # end choice main
|
||||
|
||||
|
||||
} # @comma = 1
|
||||
|
||||
#################
|
||||
# WRITE TO FILE #
|
||||
#################
|
||||
foreach $package (@packs) {
|
||||
my ($count,$holder);
|
||||
for ($count = 0; $count <= $#dirfile; $count++) {
|
||||
if ($count == 0) {
|
||||
$holder = "/$dirfile[$count]";
|
||||
my $again = "$dirfile[$count] -> $package";
|
||||
my $all = "/. -> $package";
|
||||
$again{$again}++;
|
||||
$all{$all}++;
|
||||
if ($all{$all} == 1) {
|
||||
print FILEDIR "/. -> $package\n";
|
||||
}
|
||||
if ($again{$again} == 1) {
|
||||
print FILEDIR "/$dirfile[$count] -> $package\n";
|
||||
}
|
||||
}
|
||||
# Here's where things really start to turn ugly.
|
||||
else {
|
||||
$holder = $holder . "/$dirfile[$count]";
|
||||
my $again = "$holder -> $package";
|
||||
$again{$again}++;
|
||||
if ($again{$again} == 1) {
|
||||
print FILEDIR "$holder -> $package\n";
|
||||
}
|
||||
}
|
||||
} # end for
|
||||
} # @packs - more than one package for this file
|
||||
} # end else not dir
|
||||
}
|
||||
}
|
||||
}
|
||||
close(FILEDIR);
|
||||
close(CONTENTS);
|
||||
|
||||
print "Compress contents\n";
|
||||
system "$gzip", "-9", "$contentsindex";
|
||||
utime(time,$Contents_mtime,$contentsindex);
|
||||
print "Cleaning up\n";
|
||||
# this will add a newline, but better to do a Ctrl-C than to have the
|
||||
# process hang and respawn itself - something which sometimes happens
|
||||
kill INT => $$;
|
||||
print "swim: please press Ctrl-c\n"; # just in case :)
|
||||
|
||||
# probably don't need to do this ends the program
|
||||
#undef %all;
|
||||
#undef %again;
|
||||
|
||||
} # end sub nmd
|
||||
|
||||
# this finds the package or none which equal choice section when a
|
||||
# file/dir is found with one package
|
||||
sub choice {
|
||||
|
||||
my (@package) = @_;
|
||||
my @packs;
|
||||
if ($#package == 1) {
|
||||
my $what = timing($package[1]);
|
||||
if (defined $what) {
|
||||
#$package[1] = version($package[1]);
|
||||
@packs = $what;
|
||||
}
|
||||
}
|
||||
elsif ($#package == 2) {
|
||||
my $what = timing($package[2]);
|
||||
if (defined $what) {
|
||||
#$package[2] = version($package[2]);
|
||||
@packs = $what;
|
||||
}
|
||||
}
|
||||
|
||||
return @packs;
|
||||
|
||||
} # end sub choice
|
||||
|
||||
|
||||
# this finds the package(s) or none which equal choice section when a
|
||||
# file/dir is found with more than one package
|
||||
sub comma_choice {
|
||||
|
||||
my (@choice_package) = @_;
|
||||
my (@package,@packs);
|
||||
|
||||
if (@choice_package) {
|
||||
if ($#choice_package == 0) {
|
||||
@package = split(/\//,$choice_package[0]);
|
||||
if ($#package == 1) {
|
||||
my $what = timing($package[1]);
|
||||
if (defined $what) {
|
||||
#$package[1] = version($package[1]);
|
||||
push(@packs,$what);
|
||||
}
|
||||
}
|
||||
elsif ($#package == 2) {
|
||||
my $what = timing($package[2]);
|
||||
if (defined $what) {
|
||||
#$package[2] = version($package[2]);
|
||||
push(@packs,$what);
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($#choice_package > 0) {
|
||||
# Basically, we will keep all conflicting dirs/files
|
||||
# because often they are related
|
||||
foreach (@choice_package) {
|
||||
@package = split(/\//,$_);
|
||||
if ($#package == 1) {
|
||||
my $what = timing($package[1]);
|
||||
if (defined $what) {
|
||||
push(@packs,$what);
|
||||
}
|
||||
}
|
||||
elsif ($#package == 2) {
|
||||
my $what = timing($package[2]);
|
||||
if (defined $what) {
|
||||
push(@packs,$what);
|
||||
}
|
||||
}
|
||||
}
|
||||
} # else more than 1 for choice
|
||||
} # defined choice
|
||||
return @packs;
|
||||
|
||||
} # end sub comma_choice
|
||||
|
||||
|
||||
# this sub produces a report file..in case Packages is older than Contents
|
||||
# there will be other reports, ofcourse, like if Packages is newer than
|
||||
# Contents. Uses version();
|
||||
sub timing {
|
||||
|
||||
my ($lookup) = @_;
|
||||
|
||||
my $afterlookup = nversion($lookup);
|
||||
if ($afterlookup eq 1) {
|
||||
$watch{$lookup}++;
|
||||
if ($watch{$lookup} == 1) {
|
||||
open(REPORT,">>$place/.contentsdiff-$arch-$dist.deb")
|
||||
or die "can't create a file\n";
|
||||
print REPORT "Found in Contents, not in Packages: $lookup\n";
|
||||
close(REPORT);
|
||||
}
|
||||
return;
|
||||
}
|
||||
else {
|
||||
return $afterlookup;
|
||||
}
|
||||
|
||||
} # end my timing
|
||||
|
||||
# checks npackage.deb to find version for package found in Contents
|
||||
sub nversion {
|
||||
|
||||
my ($argument) = @_;
|
||||
#ndb();
|
||||
|
||||
if (defined $argument) {
|
||||
# We will check for more than two..just in case
|
||||
if ($argument !~ /_/) {
|
||||
if (defined $ndb{$argument}) {
|
||||
$argument = $ndb{$argument};
|
||||
return $argument;
|
||||
}
|
||||
# fixed the space packages
|
||||
else {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
#untie %ndb;
|
||||
|
||||
} # end sub nversion
|
||||
|
||||
sub ndb {
|
||||
#tie %ndb, 'DB_File', "$npackages" or die "DB_File: $!";
|
||||
} # end sub ndb
|
||||
Executable
+131
@@ -0,0 +1,131 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
#use diagnostics;
|
||||
use strict;
|
||||
|
||||
################################################################################
|
||||
# Package administration and research tool for Debian #
|
||||
# Copyright (C) 1999-2000 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.#
|
||||
################################################################################
|
||||
|
||||
|
||||
=pod
|
||||
|
||||
This program only takes two argument, a temp directory and the name of the
|
||||
binary sort..sort. You can test a filedir.deb file.
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
if ($#ARGV == -1) {
|
||||
print "swim: slowswim requires arguments, see program for instructions\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my $tmp = $ARGV[0];
|
||||
my $sort = $ARGV[1];
|
||||
|
||||
pre_md();
|
||||
|
||||
# This is nmd()'s version of fastswim..also a lowmem method, after making
|
||||
# long.debian and big.debian, process_md() finishes the job.
|
||||
sub pre_md {
|
||||
|
||||
my %HL;
|
||||
my $temp;
|
||||
my %repeaters;
|
||||
my $fcount = 0;
|
||||
my @tempholder;
|
||||
|
||||
print "Sorting everything\n";
|
||||
system ("$sort $tmp/filedir.deb > $tmp/sortfiledir.deb");
|
||||
unlink("$tmp/filedir.deb");
|
||||
|
||||
# grab the keys from the sorted file
|
||||
print "Making the massive hash using lowmem\n";
|
||||
$| = 1; my $x = 1;
|
||||
open(FILEDIR, "$tmp/sortfiledir.deb") or die "where is sortfiledir.deb?\n";
|
||||
while (<FILEDIR>) {
|
||||
$x = 1 if $x == 6;
|
||||
print "|\r" if $x == 1 || $x == 4; print "/\r" if $x == 2;
|
||||
print "-\r" if $x == 3 || $x == 6; print "\\\r" if $x == 5;
|
||||
$x++;
|
||||
my ($place, $packname) = split(/ -> /,$_,2);
|
||||
push(@tempholder,"$place -> $packname");
|
||||
if ($fcount != 0) {
|
||||
my($tplace,$tpackname) = split(/ -> /,$tempholder[$fcount - 1],2);
|
||||
chomp $tpackname;
|
||||
# As long as they aren't different add to HL because they
|
||||
# belong to a group.
|
||||
if ($tplace eq $place) {
|
||||
#print "$tplace and $place\n";
|
||||
$repeaters{$tplace}++;
|
||||
if ($repeaters{$tplace} == 1) {
|
||||
$temp = 0;
|
||||
}
|
||||
else {
|
||||
$temp = $repeaters{$tplace} - 1;
|
||||
}
|
||||
$HL{$tplace}[$temp] = $tpackname;
|
||||
}
|
||||
# they new guy is different, but the old guy belongs to the
|
||||
# previous group or not, so finish adding to %HL and then
|
||||
# print out, and undef %HL
|
||||
else {
|
||||
#print "I AM DIFF $tplace\n";
|
||||
# finish adding
|
||||
$repeaters{$tplace}++;
|
||||
if ($repeaters{$tplace} == 1) {
|
||||
$temp = 0;
|
||||
}
|
||||
else {
|
||||
$temp = $repeaters{$tplace} - 1;
|
||||
}
|
||||
$HL{$tplace}[$temp] = $tpackname;
|
||||
|
||||
# print out
|
||||
open(BIG, ">>$tmp/big.debian") or die;
|
||||
open(LONG, ">>$tmp/long.debian") or die;
|
||||
my $thingo;
|
||||
foreach $thingo (sort keys %HL ) {
|
||||
my $tingy = "@{ $HL{$thingo} }";
|
||||
if (@{ $HL{$thingo} } > 1 || @{ $HL{$thingo} } eq "") {
|
||||
print LONG "$thingo -> $tingy\n";
|
||||
}
|
||||
elsif (@{ $HL{$thingo} } == 1) {
|
||||
print BIG "$thingo -> $tingy\n";
|
||||
}
|
||||
}
|
||||
close(BIG);
|
||||
close(LONG);
|
||||
|
||||
# The whole key for lowmem systems
|
||||
undef %repeaters;
|
||||
undef %HL;
|
||||
undef $tempholder[$fcount - 1];
|
||||
|
||||
}
|
||||
} # if fcount ne 0
|
||||
|
||||
$fcount++;
|
||||
}
|
||||
|
||||
# also do this in db() & ndb()
|
||||
unlink("$tmp/sortfiledir.deb");
|
||||
|
||||
|
||||
} # end sub pre_md
|
||||
Reference in New Issue
Block a user