mirror of
https://github.com/fspc/dswim.git
synced 2025-10-31 08:25:35 -04:00
108 lines
5.5 KiB
Perl
Executable File
108 lines
5.5 KiB
Perl
Executable File
#!/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
|
|
|
|
my $home = $ENV{'HOME'} . "/";
|
|
|
|
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, ">$home$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
|