bike
/
dswim
mirror of https://github.com/fspc/dswim
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
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.
36 Commits
1 Branch
0 Tags
615 KiB
Tree: 1632e1340e
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '1632e1340e'
${ noResults }
dswim/SWIM/NDB_Init.pm

2367 lines
86 KiB
Raw Normal View History

Rearranging things so that perl -I . can easily be used for development.
23 years ago
# 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.
package SWIM::NDB_Init;
use strict;
use DB_File;
use SWIM::Library;
use SWIM::Format;
use SWIM::Conf qw(:Path $default_directory $apt_cache @user_defined_section
$distribution $pwd $sort $gzip $architecture $slowswim
$longswim $apt_sources $alt);
Now non-root users can create databases to access knowledge from swim.
23 years ago
use SWIM::Global qw(%sb $argument $main::home);
Rearranging things so that perl -I . can easily be used for development.
23 years ago
use SWIM::Dir;
use SWIM::Compare;
use SWIM::MD;
use vars qw(@ISA @EXPORT);
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(initndb);
# initndb() not_installed() exist_sb() sb() compress_contests() nmd()
# --initndb --rebuildndb - exist_sb and sb are in DB_Library as well.
# this checks for the @ARG for a not-installed database make and then runs
# not_installed()
sub initndb {
my($commands) = @_;
my %commands = %$commands;
my $one_more_arg = 0;
my $save_argument;
my($arch,$dist) = which_archdist(\%commands);
$dist =~ m,^-(.*)$,; my $dis = $1; my %what;
$arch =~ m,^-(.*)$,; my $arc = $1; my @what;
my $df = $default_directory; my $contents;
my $dd = $default_directory;
if ($#ARGV != -1) {
$ARGV[0] eq "APT" ? ($default_directory = $apt_sources)
: ($default_directory = $default_directory);
}
# This provides the full path of dir/file. ../ not implemented yet.
# So, the queries can occur within each situation.
if ($#ARGV != -1) {
######################
# APT & DF SITUATION #
######################
# this part can also apply to apt
if ($ARGV[0] eq "DF" || $ARGV[0] eq "APT") {
if ($ARGV[0] eq "APT" && !defined $apt_cache) {
print "swim: this target requires apt\n";
exit;
}
$df = $apt_sources if $ARGV[0] eq "APT";
shift(@ARGV);
# which section is wanted?
my ($main,$contrib,$non_free,$non_us,$experimental,
$omain,$ocontrib,$onon_free,$onon_us,$oexperimental);
$omain = "main" if $commands->{"main"};
$ocontrib = "contrib" if $commands->{"contrib"};
$onon_free = "non-free" if $commands->{"non-free"};
$onon_us = "non-US" if $commands->{"non-us"};
#$oexperimental = "experimental"
# if $commands->{"dists"} eq "experimental";
# Are we using a traditional debian archive structure from an
# alternative distribution..or is it debian?
if ($commands->{"alt"}) {
$alt = $commands->{"alt"};
}
if (!defined $main && !defined $contrib &&
!defined $non_free && !defined $non_us) {
foreach (@user_defined_section) {
if ($_ eq "main") {
$main = "main";
}
elsif ($_ eq "contrib") {
$contrib = "contrib";
}
elsif ($_ eq "non-free") {
$non_free = "non-free";
}
elsif ($_ eq "non-US") {
$non_us = "non-US";
}
}
if (defined $commands->{"dists"}) {
if ($commands->{"dists"} eq "experimental") {
$experimental = "experimental";
}
}
elsif ($distribution eq "experimental") {
$experimental = "experimental";
}
}
################
# USER DEFINED #
################
# use user defined values for sections..if any of these aren't
# true, options override the default values
if (!defined $omain && !defined $ocontrib &&
!defined $onon_free && !defined $onon_us) {
if (defined $main) {
my $count = 1;
my $package = $alt . "_dists_" . "$dis" . "_main_" .
"binary$arch" . "_Packages";
my $release = $alt . "_dists_" . "$dis" . "_main_" .
"binary$arch" ."_Release";
opendir(DF,"$df/");
foreach (sort grep(/$package/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what{"MAIN"}[$count] = "$date!$mtime!$size!$dsite!$df/$_";
$count++;
}
closedir(DF);
$count = 1;
opendir(DF,"$default_directory");
foreach (sort grep(/$release/, readdir(DF))) {
my $releasite = (split(/_/,$_))[0];
open(RELEASE,"$default_directory/$_");
while (<RELEASE>) {
if (m,^Version:,) {
m,^Version:\s+(.*),; my $Version = $1;
my $scount;
foreach $scount (0 .. $#{ $what{"MAIN"} }) {
if (defined $what{"MAIN"}[$scount]) {
my $dsite = (split(/!/,$what{"MAIN"}[$scount]))[3];
if ($dsite eq $releasite) {
$what{"MAIN"}[$scount] =
$what{"MAIN"}[$scount] ."!$Version";
}
}
}
}
}
close(RELEASE);
$count++;
}
closedir(DF);
}
if (defined $contrib) {
my $count = 1;
my $package = $alt . "_dists_" . "$dis" . "_contrib_" .
"binary$arch" . "_Packages";
my $release = $alt . "_dists_" . "$dis" . "_contrib_" .
"binary$arch" . "_Release";
opendir(DF,"$df/");
foreach (sort grep(/$package/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what{"CONTRIB"}[$count] = "$date!$mtime!$size!$dsite!$df/$_";
$count++;
}
closedir(DF);
$count = 1;
opendir(DF,"$default_directory");
foreach (sort grep(/$release/, readdir(DF))) {
my $releasite = (split(/_/,$_))[0];
open(RELEASE,"$default_directory/$_");
while (<RELEASE>) {
if (m,^Version:,) {
m,^Version:\s+(.*),; my $Version = $1;
my $scount;
foreach $scount (0 .. $#{ $what{"CONTRIB"} }) {
if (defined $what{"CONTRIB"}[$scount]) {
my $dsite = (split(/!/,$what{"CONTRIB"}[$scount]))[3];
if ($dsite eq $releasite) {
$what{"CONTRIB"}[$scount] =
$what{"CONTRIB"}[$scount] ."!$Version";
}
}
}
}
}
close(RELEASE);
$count++;
}
closedir(DF);
}
if (defined $non_free) {
my $count = 1;
my $package = $alt . "_dists_" . "$dis" . "_non-free_" .
"binary$arch" . "_Packages";
my $release = $alt . "_dists_" . "$dis" . "_non-free_" .
"binary$arch" . "_Release";
opendir(DF,"$df/");
foreach (sort grep(/$package/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what{"NON-FREE"}[$count] = "$date!$mtime!$size!$dsite!$df/$_";
#print "$date $dsite $size\n";
$count++;
}
closedir(DF);
$count = 1;
opendir(DF,"$default_directory");
foreach (sort grep(/$release/, readdir(DF))) {
my $releasite = (split(/_/,$_))[0];
open(RELEASE,"$default_directory/$_");
while (<RELEASE>) {
if (m,^Version:,) {
m,^Version:\s+(.*),; my $Version = $1;
my $scount;
foreach $scount (0 .. $#{ $what{"NON-FREE"} }) {
if (defined $what{"NON-FREE"}[$scount]) {
my $dsite = (split(/!/,$what{"NON-FREE"}[$scount]))[3];
if ($dsite eq $releasite) {
$what{"NON-FREE"}[$scount] =
$what{"NON-FREE"}[$scount] ."!$Version";
}
}
}
}
}
close(RELEASE);
$count++;
}
closedir(DF);
}
if (defined $non_us) {
my $count = 1;
# on package1 hope $alt is correct?
my $package1 = $alt . "_" . "non-US" . "_" . "$dis" .
"_" . "binary$arch" . "_Packages";
my $package2 = $alt . "_dists_" . "$dis" . "_non-US_" .
"binary$arch" . "_Packages";
opendir(DF,"$df/");
foreach (sort grep(/$package1|$package2/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what{"NON-US"}[$count] =
"$date!$mtime!$size!$dsite!$df/$_!none";
$count++;
}
closedir(DF);
}
if (defined $experimental) {
my $count = 1;
my $package = $alt ."_project_experimental_Packages";
opendir(DF,"$df/");
foreach (sort grep(/$package/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what{"EXPERIMENTAL"}[$count] =
"$date!$mtime!$size!$dsite!$df/$_!none";
$count++;
}
closedir(DF);
}
}
################
# COMMAND LINE #
################
else {
if (defined $omain) {
my $count = 1;
my $package = $alt . "_dists_" . "$dis" . "_main_" .
"binary$arch" . "_Packages";
my $release = $alt . "_dists_" . "$dis" . "_main_" .
"binary$arch" . "_Release";
opendir(DF,"$df/");
foreach (sort grep(/$package/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what{"MAIN"}[$count] = "$date!$mtime!$size!$dsite!$df/$_";
$count++;
}
closedir(DF);
$count = 1;
opendir(DF,"$default_directory");
foreach (sort grep(/$release/, readdir(DF))) {
my $releasite = (split(/_/,$_))[0];
open(RELEASE,"$default_directory/$_");
while (<RELEASE>) {
if (m,^Version:,) {
m,^Version:\s+(.*),; my $Version = $1;
my $scount;
foreach $scount (0 .. $#{ $what{"MAIN"} }) {
if (defined $what{"MAIN"}[$scount]) {
my $dsite = (split(/!/,$what{"MAIN"}[$scount]))[3];
if ($dsite eq $releasite) {
$what{"MAIN"}[$scount] =
$what{"MAIN"}[$scount] ."!$Version";
}
}
}
}
}
close(RELEASE);
$count++;
}
closedir(DF);
}
if (defined $ocontrib) {
my $count = 1;
my $package = $alt . "_dists_" . "$dis" . "_contrib_" .
"binary$arch" . "_Packages";
my $release = $alt . "_dists_" . "$dis" . "_contrib_" .
"binary$arch" . "_Release";
opendir(DF,"$df/");
foreach (sort grep(/$package/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what{"CONTRIB"}[$count] = "$date!$mtime!$size!$dsite!$df/$_";
$count++;
}
closedir(DF);
$count = 1;
opendir(DF,"$default_directory");
foreach (sort grep(/$release/, readdir(DF))) {
my $releasite = (split(/_/,$_))[0];
open(RELEASE,"$default_directory/$_");
while (<RELEASE>) {
if (m,^Version:,) {
m,^Version:\s+(.*),; my $Version = $1;
my $scount;
foreach $scount (0 .. $#{ $what{"CONTRIB"} }) {
if (defined $what{"CONTRIB"}[$scount]) {
my $dsite = (split(/!/,$what{"CONTRIB"}[$scount]))[3];
if ($dsite eq $releasite) {
$what{"CONTRIB"}[$scount] =
$what{"CONTRIB"}[$scount] ."!$Version";
}
}
}
}
}
close(RELEASE);
$count++;
}
closedir(DF);
}
if (defined $onon_free) {
my $count = 1;
my $package = $alt . "_dists_" . "$dis" . "_non-free_" .
"binary$arch" . "_Packages";
my $release = $alt . "_dists_" . "$dis" . "_non-free_" .
"binary$arch" . "_Release";
opendir(DF,"$df/");
foreach (sort grep(/$package/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what{"NON-FREE"}[$count] = "$date!$mtime!$size!$dsite!$df/$_";
#print "$date $dsite $size\n";
$count++;
}
closedir(DF);
$count = 1;
opendir(DF,"$default_directory");
foreach (sort grep(/$release/, readdir(DF))) {
my $releasite = (split(/_/,$_))[0];
open(RELEASE,"$default_directory/$_");
while (<RELEASE>) {
if (m,^Version:,) {
m,^Version:\s+(.*),; my $Version = $1;
my $scount;
foreach $scount (0 .. $#{ $what{"NON-FREE"} }) {
if (defined $what{"NON-FREE"}[$scount]) {
my $dsite = (split(/!/,$what{"NON-FREE"}[$scount]))[3];
if ($dsite eq $releasite) {
$what{"NON-FREE"}[$scount] =
$what{"NON-FREE"}[$scount] ."!$Version";
}
}
}
}
}
close(RELEASE);
$count++;
}
closedir(DF);
}
if (defined $onon_us) {
my $count = 1;
my $package1 = $alt . "non-US" . "_" . "$dis" . "_" .
"binary$arch" . "_Packages";
my $package2 = $alt . "_dists_" . "$dis" . "_non-US_" .
"binary$arch" . "_Packages";
opendir(DF,"$df/");
foreach (sort grep(/$package1|$package2/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what{"NON-US"}[$count] =
"$date!$mtime!$size!$dsite!$df/$_!none";
#print "$date $dsite $size\n";
$count++;
}
closedir(DF);
}
}
####################
# PACKAGE PRINTOUT #
####################
# check to see that all Packages have a Release file, there is
# no date check on Release files because it is assumed that they
# will be kept current. Versions apt >= 3.2 download *Release.
# "none" if no Release is found, avoids unecessary errors, here.
# If all the Release versions are the same check against a file
# to find if there is a change, otherwise check against
# themselves.
my ($section,$site,$scount,%CHECK);
if (defined %what) {
foreach $section (keys %what) {
foreach $scount (0 .. $#{ $what{$section} }) {
if (defined $what{$section}[$scount]) {
my @CHECK = split(/!/,$what{$section}[$scount]);
if ($#CHECK != 5) {
print STDERR "swim: Missing Release files.\n";
print STDERR "swim: This can occur when there is no Release file found at the site.\n";
$what{$section}[$scount] = $what{$section}[$scount] ."!none";
}
elsif ($CHECK[$#CHECK] ne "none") {
$CHECK{$CHECK[$#CHECK]} = "";
}
}
}
}
}
my @AMT = keys %CHECK;
# Time to store Release version number, if it is the same - no
# need to, if it has changed, time to make an important warning.
# Obviously this can occur for stable or unstable.
my $place = finddb(\%commands); my (@CHANGE,$CHANGE);
if (-e "$place/.release$arch$dist") {
open(VERSION,"$place/.release$arch$dist") or exit;
if ($#AMT == 0) {
@CHANGE = <VERSION>; chomp $CHANGE[0];
if ($CHANGE[0] ne $AMT[0]) {
$CHANGE = $CHANGE[0];
}
}
}
else {
open(VERSION,">$place/.release$arch$dist") or exit;
if (!defined <VERSION>) {
if ($#AMT == 0) {
print VERSION $AMT[0];
}
}
}
if (!$commands->{"cron"}) {
# print out the stuff for analysis
$~ = "SUBJECT";
$subsite = "Site"; $subdate = "Date"; $subsize = "Size (bytes)";
$number = "###"; $subrelease = "Release";
my $ex;
defined %what ?
write STDOUT :
($ex = 0);
if (defined $ex) {
#if ($commands->{"dists"} || $commands->{"arch"}) {
print "swim: no Packages exist for $dis $arc\n";
exit;
}
# Some changed
if ($#AMT > 0) {
$~ = "CENTER";
$section = "WARNING: RELEASE CHANGE";
$center = $section;
write STDOUT;
print "\n";
}
# All changed
if (defined $CHANGE) {
$~ = "CENTER";
$section = "WARNING: $AMT[0] to $CHANGE";
$center = $section;
write STDOUT;
print "\n";
}
foreach $section (keys %what) {
$~ = "CENTER";
#print "CENTER $section\n";
$center = $section;
write STDOUT;
foreach $scount (0 .. $#{ $what{$section} }) {
if (defined $what{$section}[$scount]) {
$~ = "SDS";
my ($date,$size,$site,$release) =
(split(/!/,$what{$section}[$scount],))[0,2,3,5];
$number = $scount; $sdsite = $site;
$sdsdate = $date; $sdsize = $size;
$sdsrelease = $release;
write STDOUT;
}
}
print "\n";
}
#######################
# PACKAGE INTERACTIVE #
#######################
# Let the person decide on one, or none for each section.
$~ = "STDIN";
my ($OK,%GOON);
my $scal_count = 1;
my $end = (split(/\//, scalar(%what)))[0];
AGAIN: while (!defined $OK) {
foreach $section (keys %what) {
if (!defined $GOON{$section}) {
print "swim: for $section, which ### do you want?: ";
my $use_num = <STDIN>; chomp $use_num;
if ($use_num ne "" && $use_num =~ /\b\d+\b/) {
if (defined $what{$section}[$use_num]) {
push(@ARGV,(split(/!/,$what{$section}[$use_num]))[4]);
$GOON{$section} = $section;
if ($scal_count == $end) {
$OK = "yes";
}
}
else {
if ($scal_count < $end) {
print "swim: do you want to go on to the next section? (yes or no): ";
}
else {
print "swim: do you want this section? (yes or no): ";
$OK = "yes";
}
my $again = <STDIN>; #chomp $again;
while ($again eq "\n" || !($again eq "yes\n"
|| $again eq "no\n")) {
print "swim: please enter yes or no: ";
$again = <STDIN>;
}
$GOON{$section} = $section if $again ne "no\n";
$scal_count++ if $again eq "yes\n";
$end++ if $again eq "yes\n";
next AGAIN if $again eq "no\n";
}
}
else {
if ($scal_count < $end) {
print "swim: do you want to go on to the next section? (yes or no): ";
}
else {
print "swim: do you want this section? (yes or no): ";
$OK = "yes";
}
my $again = <STDIN>; #chomp $again;
while ($again eq "\n" || !($again eq "yes\n"
|| $again eq "no\n")) {
print "swim: please enter yes or no: ";
$again = <STDIN>;
}
$GOON{$section} = $section if $again ne "no\n";
$scal_count++ if $again eq "yes\n";
$end++ if $again eq "yes\n";
next AGAIN if $again eq "no\n";
}
}
$scal_count++;
} # for section
}
exit if $#ARGV == -1;
################################
# APT || DF CONTENTS SITUATION #
################################
if ($commands->{"Contents"}) {
if ($commands->{"Contents"} eq "FDBDF" ||
$commands->{"Contents"} eq "DF") {
$df = $dd;
}
my $count = 1;
$contents = "_" . "$dis" . "_" . "Contents$arch";
opendir(DF,"$df/");
foreach (sort grep(/$contents/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what[$count] = "$date!$mtime!$size!$dsite!$df/$_!none";
$count++;
}
closedir(DF);
#####################
# CONTENTS PRINTOUT #
#####################
# print out the stuff for analysis
$~ = "SUBJECT";
$subsite = "Site"; $subdate = "Date"; $subsize = "Size (bytes)";
$number = "###";
defined @what ?
write STDOUT :
($ex = 0);
if (defined $ex) {
print "swim: no Contents exist for $dis $arc\n";
# there is a reason to stop ofcourse!
exit;
}
$~ = "CENTER";
#print "CENTER $section\n";
$center = "CONTENTS";
write STDOUT;
foreach $scount (0 .. $#what) {
if (defined $what[$scount]) {
$~ = "SDS";
my ($date,$size,$site,$release) =
(split(/!/,$what[$scount],))[0,2,3,5];
$number = $scount; $sdsite = $site;
$sdsdate = $date; $sdsize = $size;
$sdsrelease = $release;
write STDOUT;
}
}
########################
# CONTENTS INTERACTIVE #
########################
undef $OK; undef %GOON;
$~ = "STDIN";
print "\n";
AGAIN: while (!defined $OK) {
foreach $scount (1 .. $#what) {
print "swim: for CONTENTS, which ### do you want?: ";
my $use_num = <STDIN>; chomp $use_num;
if ($use_num ne "" && $use_num =~ /\b\d+\b/) {
if (defined $what[$use_num]) {
($contents) = (split(/!/,$what[$use_num]))[4];
$OK = "yes";
last;
}
else {
print "swim: do not use CONTENTS? (yes or no): ";
my $again = <STDIN>;
while ($again eq "\n" || !($again eq "yes\n"
|| $again eq "no\n")) {
print "swim: please enter yes or no: ";
$again = <STDIN>;
}
next AGAIN if $again eq "no\n";
$OK = "yes" if $again eq "yes\n"; last if $again eq "yes\n";
}
}
else {
print "swim: do not use CONTENTS? (yes or no): ";
my $again = <STDIN>;
while ($again eq "\n" || !($again eq "yes\n"
|| $again eq "no\n")) {
print "swim: please enter yes or no: ";
$again = <STDIN>;
}
next AGAIN if $again eq "no\n";
$OK = "yes" if $again eq "yes\n"; last if $again eq "yes\n";
}
}
}
} # if Contents
} # if not cron
########
# CRON #
########
# if no user interaction is wanted, this will figure out which
# Packages for each section and Contents database is the newest
# and use them. If the Release has changed --cron will not
# continue. This uses APT and/or DF.
else {
if ($#AMT > 0 || defined $CHANGE) {
print "swim: RELEASE CHANGE\n";
exit;
}
############
# PACKAGES #
############
my ($section,$site,$scount,%TIME);
if (defined %what) {
foreach $section (keys %what) {
foreach $scount (0 .. $#{ $what{$section} }) {
if (defined $what{$section}[$scount]) {
my $time = (split(/!/,$what{$section}[$scount]))[1];
$TIME{$section}{"$section!$scount"} = $time;
}
}
}
}
foreach $section (keys %TIME) {
my @comparer;
foreach $site (keys %{ $TIME{$section} }) {
push(@comparer,$TIME{$section}{$site});
}
@comparer = sort { $b <=> $a } @comparer;
my $newest = shift @comparer;
my %only_one;
foreach $site (keys %{ $TIME{$section} }) {
if ($TIME{$section}{$site} == $newest) {
$only_one{$newest}++;
if ($only_one{$newest} == 1) {
my($sect,$count) = (split(/!/,$site))[0,1];
push(@ARGV,(split(/!/,$what{$sect}[$count]))[4]);
}
}
}
}
exit if $#ARGV == -1;
############
# CONTENTS #
############
if ($commands->{"Contents"}) {
if ($commands->{"Contents"} eq "FDBDF" ||
$commands->{"Contents"} eq "DF") {
$df = $dd;
}
my $count = 1;
$contents = "_" . "$dis" . "_" . "Contents$arch";
opendir(DF,"$df/");
foreach (sort grep(/$contents/, readdir(DF))) {
my ($size,$mtime) = (stat("$df/$_"))[7,9];
my $date = localtime($mtime);
my $dsite = (split(/_/,$_))[0];
$what[$count] = "$date!$mtime!$size!$dsite!$df/$_!none";
$count++;
}
closedir(DF);
my @time;
foreach (@what) {
if (defined $_) {
push(@time,$_);
}
}
@what = map { $_->[1] }
sort { $b->[0] <=> $a->[0] }
map { [ (split(/!/,$_))[1], $_ ] }
@time;
$contents = (split(/!/,$what[0]))[4];
} # end Contents
}
} # end total thing pertaining to APT DF
foreach (@ARGV) {
###############
# SITUATION 0 #
###############
if (m,\.\./|^\.\.$,) {
if ($_ !~ m,/[\w-+]+/[\.\$\^\+\?\*\[\]\w-]*$,) {
my $dd; tr/\/// ? ($dd = tr/\///) : ($dd = 1);
my @pwd = split(m,/,,$pwd);
s,\.\./,,g;
my $tpwd = "";
for (1 .. $#pwd - $dd) {
$_ == 1 ? ($tpwd = "/$pwd[$_]")
: ($tpwd = $tpwd . "/$pwd[$_]");
}
$_ ne ".." ? ($argument = "$tpwd/$_") : ($argument = "$tpwd/");
}
else { print "swim: not implemented yet\n"; exit; }
dir(\%commands);
fir(\%commands);
#print "0 $argument\n";
if ($one_more_arg > 0) {
$argument = qq($save_argument $argument);
}
$one_more_arg++;
$save_argument = $argument;
}
###############
# SITUATION I #
###############
if ( m,\/,) {
$argument = $_;
if ($argument =~ m,^\.\/.*,) {
if ($pwd !~ m,^\/$,) {
$argument =~ m,^\.([^\.].*$),;
$argument = "$pwd$1";
}
else {
$argument =~ m,^\.([^\.].*$),;
$argument = "$1";
}
}
dir(\%commands);
fir(\%commands);
#print "I $argument\n";
if ($one_more_arg > 0) {
$argument = qq($save_argument $argument);
}
$one_more_arg++;
$save_argument = $argument;
}
################
# SITUATION II #
################
elsif ($pwd =~ m,^\/$,) {
$argument = "/$_";
dir(\%commands);
fir(\%commands);
#print "II $argument\n";
if ($one_more_arg > 0) {
$argument = qq($save_argument $argument);
}
$one_more_arg++;
$save_argument = $argument;
}
#################
# SITUATION III #
#################
else {
$argument = "$pwd/$_";
if ($argument =~ m,\.$,) {
$argument =~ m,(.*)\.$,;
$argument = $1;
}
dir(\%commands);
fir(\%commands);
#print "III $argument\n";
if ($one_more_arg > 0) {
$argument = qq($save_argument $argument);
}
$one_more_arg++;
$save_argument = $argument;
}
} # end foreach
# this is where SWIM::NDB::update_packages_ndb can be, too.
not_installed(\%commands) if $commands->{"initndb"} ||
$commands->{"rebuildndb"};
if ($commands->{"ndb"}) {
require SWIM::NDB;
SWIM::NDB->import(qw(update_packages_ndb));
update_packages_ndb(\%commands,$contents);
}
}
# NO ARGUMENTS
else {
print "swim: no Packages file mentioned\n";
exit;
}
############
# CONTENTS #
############
# Figure out where Contents is
if ($commands->{"Contents"}) {
my ($Contents,$FDB);
for ($commands->{"Contents"}) {
if ($commands->{"Contents"} =~ /^FDB/) {
s/FDB//;
$FDB = "yes";
}
if ($commands->{"Contents"} eq "FDBDF" ||
$commands->{"Contents"} eq "DF") {
$Contents = $contents;
}
###############
# SITUATION 0 #
###############
# this doesn't work to well for anything less simple than ../../
elsif (m,^\.\./|^\.\.$,) {
if ($_ !~ m,/[\w-+]+/[\.\$\^\+\?\*\[\]\w-]*$,) {
my $dd; tr/\/// ? ($dd = tr/\///) : ($dd = 1);
my @pwd = split(m,/,,$pwd);
s,\.\./,,g;
my $tpwd = "";
for (1 .. $#pwd - $dd) {
$_ == 1 ? ($tpwd = "/$pwd[$_]")
: ($tpwd = $tpwd . "/$pwd[$_]");
}
$_ ne ".." ? ($Contents = "$tpwd/$_") : ($Contents = "$tpwd/");
}
dir(\%commands);
fir(\%commands);
}
###############
# SITUATION I #
###############
elsif ( m,\/,) {
$Contents = $_;
if ($Contents =~ m,^\.\/.*,) {
if ($pwd !~ m,^\/$,) {
$Contents =~ m,^\.([^\.].*$),;
$Contents = "$pwd$1";
}
else {
$Contents =~ m,^\.([^\.].*$),;
$Contents = "$1";
}
}
dir(\%commands);
fir(\%commands);
}
################
# SITUATION II #
################
elsif ($pwd =~ m,^\/$,) {
$Contents = "/$_";
dir(\%commands);
fir(\%commands);
}
#################
# SITUATION III #
#################
else {
$Contents = "$pwd/$_";
if ($Contents =~ m,\.$,) {
$Contents =~ m,(.*)\.$,;
$Contents = $1;
}
dir(\%commands);
fir(\%commands);
}
}
if (!defined $FDB) {
# To the total db thing. Will have to find Contents.
if ($commands->{"initndb"} || $commands->{"rebuildndb"}) {
nmd($Contents,\%commands);
# Do the the lowmem approach
system "$slowswim", $tmp, $sort;
# has to know --arch and --dist
process_md(\%commands)
}
elsif ($commands->{"ndb"}) {
exit;
}
}
elsif (defined $FDB) {
compress_contents($Contents,\%commands);
}
} # if Contents
} # end sub initndb
# This represents one on the most useful features of swim, the ability to
# evauluate a non-installed system by grabbing information from the
# Packages and Contents files. Ofcourse it is a hypothetical system, because
# lots of packages which wouldn't be able to live with one another are
# presented, and a few of swim's features which would normally be useful on a
# real system are disabled. But, this is a great way to explore around and
# discover things. The goal here is to provide information to
# people who don't even have dpkg installed so available won't be used.
# This will include architecture called and all. frozen, stable, and
# unstable distributions will have separate dbs. What will be kept will be
# determined by version. This is set-up so a person can use an indices
# file as well as a specific Packages, and Contents files (obviously, the
# proper Contents file will have to be used).
sub not_installed {
my ($commands) = @_;
my %commands = %$commands;
#my whatever that is
my ($arch, $dist);
my @Tdescription;
my @description;
my @ldescription;
my @package;
my %ndb;
my @name;
my $count = 0;
my $the_status;
my $status;
my @essential;
my $priority;
my $section;
my $installed_size; # at the very end
my $maintainer;
my $source; # at the very end
my $version;
my $ver;
my %ngb;
my %group;
my $group;
# Keeps a package->version database
# to save time over using status
my %nsb;
my @status;
my $things; # /.
my $scount = 0;
my ($pre_depends, $depends, $replaces, $provides, $recommends,
$suggests, $conflicts, @REPLACE);
my @conffiles;
my @conf;
my @complete;
my @form;
my @formly;
my $format_deb = "$tmp/format.deb";
my ($filename,@FILENAME);
my $size;
my @MD5SUM;
my ($ok,$goon); # arch & dist skippers
my $distro; # the distribution in the Packages
# when revision: exists this helps md5sumo() since the package is labeled
# differently than the version number everywhere else.
my @revision;
# Let's determine what architecture and distribution this person is
# interested in.
#if (defined $architecture || defined $distribution) {
# ($arch,$dist) = which_archdist();
#}
if ($commands->{"arch"}) {
$architecture = $commands->{"arch"};
}
else {
$architecture = $architecture;
}
if ($commands->{"dists"}) {
$distribution = $commands->{"dists"};
($arch,$dist) = which_archdist(\%commands);
}
else {
$distribution = $distribution;
($arch,$dist) = which_archdist(\%commands);
}
# we only need to clean-up, and decide what to do once.
# Let's decide whether we should even go on. If it is --initdb, and
# the databases already exist, nothing should be touched, but if it is
# --rebuilddb and they exist, then they are removed and remade from
# scratch.
# But first, better clean up any files in $tmp in case of an aborted
# database formation
unlink(<$tmp/DEBIAN*>) if -e "$tmp/DEBIANaa";
unlink("$tmp/transfer.deb") if -e "$tmp/transfer.deb";
unlink("$tmp/big.debian") if -e "$tmp/big.debian";
unlink("$tmp/long.debian") if -e "$tmp/long.debian";
# People may not want to use --Contents for a variety of reasons, so
# nfileindex-arch-dist.deb may not exist. If this is the case querying
# will have to be done a little bit differently.
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
if ($commands->{"initndb"}) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/npackages$arch$dist.deb") {
Rearranging things so that perl -I . can easily be used for development.
23 years ago
print "swim: use --rebuildndb\n";
exit;
}
else {
# if a database happens to be missing
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/npackages$arch$dist.deb") {
unlink("$main::home$parent$library/npackages$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/nfileindex$arch$dist.deb") {
unlink("$main::home$parent$library/nfileindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ngroupindex$arch$dist.deb") {
unlink("$main::home$parent$library/ngroupindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ncontentsindex$arch$dist.deb") {
unlink("$main::home$parent$library/ncontentsindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ncontentsindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/ncontentsindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
# might as well delete these to free some room
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/nsearchindex$arch$dist.deb") {
unlink("$main::home$parent$library/nsearchindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/nsearchindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/nsearchindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ndirindex$arch$dist.deb") {
unlink("$main::home$parent$library/ndirindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ndirindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/ndirindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
}
}
# this only works if all databases exist.
elsif ($commands->{"rebuildndb"}) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/npackages$arch$dist.deb") {
unlink("$main::home$parent$library/npackages$arch$dist.deb");
unlink("$main::home$parent$library/nfileindex$arch$dist.deb");
unlink("$main::home$parent$library/ngroupindex$arch$dist.deb");
unlink("$main::home$parent$library/nstatusindex$arch$dist.deb");
if (-e "$main::home$parent$library/ncontentsindex$arch$dist.deb") {
unlink("$main::home$parent$library/ncontentsindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ncontentsindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/ncontentsindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
# might as well delete these to free some room
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/nsearchindex$arch$dist.deb") {
unlink("$main::home$parent$library/nsearchindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/nsearchindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/nsearchindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ndirindex$arch$dist.deb") {
unlink("$main::home$parent$library/ndirindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ndirindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/ndirindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
}
else {
print "swim: use --initndb to create databases\n";
exit;
}
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
if ($commands->{"initndb"}) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$base/npackages$arch$dist.deb") {
Rearranging things so that perl -I . can easily be used for development.
23 years ago
print "swim: use --rebuildndb\n";
exit;
}
else {
# if a database happens to be missing
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$base/npackages$arch$dist.deb") {
unlink("$main::home$parent$base/npackages$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$base/nfileindex$arch$dist.deb") {
unlink("$main::home$parent$base/nfileindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ngroupindex$arch$dist.deb") {
unlink("$main::home$parent$base/ngroupindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ncontentsindex$arch$dist.deb") {
unlink("$main::home$parent$library/ncontentsindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ncontentsindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/ncontentsindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
# might as well delete these to free some room
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/nsearchindex$arch$dist.deb") {
unlink("$main::home$parent$base/nsearchindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/nsearchindex$arch$dist.deb.gz") {
unlink("$main::home$parent$base/nsearchindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ndirindex$arch$dist.deb") {
unlink("$main::home$parent$library/ndirindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ndirindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/ndirindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
}
}
# this only works if all databases exist.
elsif ($commands->{"rebuildndb"}) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$base/npackages$arch$dist.deb") {
unlink("$main::home$parent$base/npackages$arch$dist.deb");
unlink("$main::home$parent$base/nfileindex$arch$dist.deb");
unlink("$main::home$parent$base/ngroupindex$arch$dist.deb");
unlink("$main::home$parent$base/nstatusindex$arch$dist.deb");
if (-e "$main::home$parent$library/ncontentsindex$arch$dist.deb") {
unlink("$main::home$parent$library/ncontentsindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ncontentsindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/ncontentsindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
# might as well delete these to free some room
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/nsearchindex$arch$dist.deb") {
unlink("$main::home$parent$library/nsearchindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/nsearchindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/nsearchindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ndirindex$arch$dist.deb") {
unlink("$main::home$parent$library/ndirindex$arch$dist.deb");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/ndirindex$arch$dist.deb.gz") {
unlink("$main::home$parent$library/ndirindex$arch$dist.deb.gz");
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
}
else {
print "swim: use --initndb to create databases\n";
exit;
}
}
}
# which section is wanted?
my ($main,$contrib,$non_free,$non_us);
$main = "main" if $commands->{"main"};
$contrib = "contrib" if $commands->{"contrib"};
$non_free = "non-free" if $commands->{"non-free"};
# hopefully US is always capitalized -- watch this
$non_us = "non-US" if $commands->{"non-us"};
if (!defined $main && !defined $contrib && !defined $non_free &&
!defined $non_us) {
foreach (@user_defined_section) {
if ($_ eq "main") {
$main = "main";
}
elsif ($_ eq "contrib") {
$contrib = "contrib";
}
elsif ($_ eq "non-free") {
$non_free = "non-free";
}
elsif ($_ eq "non-US") {
$non_us = "non-US";
}
}
}
#!!!
print scalar(localtime), "\n";
# remove the version check file
my $place = finddb(\%commands);
if ($commands->{"v"}) {
unlink("$place/.version_compare");
}
# will use dir() and fir() to find path to Packages or Package.gz
# to make things easy, only one or more compressed files, or
# one or more non-compressed files may be used together in a set.
print "Data is being gathered\n";
my @check_arg = split(/\s/,$argument);
my $ac = 0;
my $gz;
foreach (@check_arg) {
if ($ac == 0) {
if (-B || m,\.(gz|Z)$,) {
$argument = "gzip -dc $argument|";
$gz = "yes";
}
else {
$argument = "cat $argument|";
}
}
else {
if (-B || m,\.(gz|Z)$,) {
if (!defined $gz) {
print "swim: targets must be one set of compressed or uncompressed file(s)\n";
exit;
}
}
else {
if (defined $gz) {
print "swim: targets must be one set of compressed or uncompressed file(s)\n";
exit;
}
}
}
$ac++;
}
# I decided to not keep more than one instance of a package if
# it happens to have more than one version, this means running
# a check, but if the package exists in another architecture, then
# it isn't a repeat.
my (%Package_count,%not_me,$packler,%not_me2,%warch,%arc);
open(PACKAGE, "$argument");
while (<PACKAGE>) {
if (/^Package:/i) {
$packler = substr($_,9); chomp $packler;
$Package_count{$packler}++;
}
elsif (/^Version:/) {
# decide who shall rule with the greatest version
my $version = substr($_,9); chomp $version;
$not_me{$packler} = $version if $Package_count{$packler} == 1;
if ($Package_count{$packler} > 1) {
my $answer = comparison($not_me{$packler},$version);
if ($answer eq "<" || $answer eq "r<" || $answer eq "") {
delete $not_me{$packler}; delete $Package_count{$packler};
$not_me{$packler} = $version; $Package_count{$packler} = 1;
delete $not_me2{$packler}; $not_me2{$packler} = $version;
}
else {
$not_me2{$packler} = $not_me{$packler};
delete $Package_count{$packler}; $Package_count{$packler} = 1;
}
}
} # elsif version
elsif (/^Architecture:/) {
my $which_architecture = substr($_,14);
chomp $which_architecture;
if (!defined $warch{$packler}) {
$warch{$packler} = $which_architecture;
}
else {
$warch{$packler} = $warch{$packler} . " $which_architecture";
}
# The assumption here is that there will never be two of the
# same architecture along with different ones, rather in cases
# where there are other archs, each will be unique, and where
# there are two or more of the same arch, a genuine repeat has
# occurred, this should cover the experimental dist.
if (defined $not_me2{$packler}) {
$arch =~ /-(.*)/; my $archi = $1;
#print "$packler\n";
foreach (split(/\s/,$warch{$packler})) {
#print "$_\n";
if ($_ eq $archi) {
$arc{"$archi$packler"}++;
#print "$archi$packler\n";
}
}
if (defined $arc{"$archi$packler"}) {
if ($arc{"$archi$packler"} == 1) {
delete $not_me2{$packler};
}
}
}
} # elsif arch
}
close(PACKAGE);
undef %warch; undef %Package_count; undef %not_me;
my @hu = keys %not_me2;
print "REPEATS:" if $#hu != -1;
for (keys %not_me2) {
print " $_"; #print " $_ $not_me2{$_}";
}
print "\n" if $#hu != -1;
my %equalizer; $| = 1; my $x = 0;
open(PRETTY, ">$format_deb");
open(PACKAGE, "$argument");
while (<PACKAGE>) {
# Package name
if (/^Package:|^PACKAGE:/) {
@package = split(/: /,$_);
chomp $package[1];
$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++;
}
# Some other pertinent fields
# All this stuff can be placed together..since it is generally nice
# to know these things at one glance, in this order.
# Package: Status: (will check database if it exists ver.)
# Version: Essential: (yes or no)
# Section: Priority:
# Installed-Size: Source: (if different from binary)
# Size: Architecture:
# Maintainer:
# Distribution: (stable, unstable, frozen, experimental - depending on
# version. --latest_version will only keep highest ver.)
# Description:
elsif (/^Version:/) {
$version = $_;
chomp $version;
my $vion = substr($version,9);
my $pv = $package[1] . "_" . $vion;
if ($scount == 0) {
$things = $pv;
}
else {
$things = $things . " $pv";
}
$scount++;
}
elsif (/^Priority:/) {
$priority = $_;
}
elsif (/^Section:/) {
$section = $_;
# make the hash for the groupindex.deb
$group = substr($section,9);
chomp $group;
if (!defined $group{$group}) {
$group{$group} = $package[1];
#$nping->put($group,$package[1]);
}
else {
$group{$group} = "$group{$group} $package[1]";
#$nping->put($group,"$group{$group} $package[1]");
}
}
elsif (/^Essential:/) {
@essential = split(/: /,$_);
}
elsif (/^Maintainer:/) {
$maintainer = $_;
}
# This stuff will be available with seperate query flags or -T
elsif (/^Pre-Depends:/) {
$pre_depends = $_;
if (defined($pre_depends)) {
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "PRE";
push(@REPLACE, "$nv");
push(@REPLACE, $pre_depends);
}
}
elsif (/^Depends:/) {
$depends = $_;
if (defined($depends)) {
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "DEP";
push(@REPLACE, "$nv");
push(@REPLACE, $depends);
}
}
elsif (/^Recommends:/) {
$recommends = $_;
if (defined($recommends)) {
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "REC";
push(@REPLACE, "$nv");
push(@REPLACE, $recommends);
}
}
elsif (/^Suggests:/) {
$suggests = $_;
if (defined($suggests)) {
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "SUG";
push(@REPLACE, "$nv");
push(@REPLACE, $suggests);
}
}
elsif (/^Conflicts:/) {
$conflicts = $_;
if (defined($conflicts)) {
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "CON";
push(@REPLACE, "$nv");
push(@REPLACE, $conflicts);
}
}
elsif (/^Provides:/) {
$provides = $_;
if (defined($provides)) {
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "PRO";
push(@REPLACE, "$nv");
push(@REPLACE, $provides);
}
}
elsif (/^Replaces:/) {
$replaces = $_;
if (defined($replaces)) {
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "REP";
push(@REPLACE, "$nv");
push(@REPLACE, $replaces);
}
}
# These next two determine whether to skip or keep the data.
# Filename has the name of the distribution.
##############
# ARCH CHECK #
##############
elsif (/^Architecture:/) {
my $which_architecture = substr($_,14);
chomp $which_architecture;
$arch =~ /-(.*)/; my $archi = $1;
### REPEATERS ###
my $vion = substr($version,9);
if (defined $not_me2{$package[1]}) {
if ($not_me2{$package[1]} ne $vion) {
#print "Pack $package[1]\n";
$which_architecture = "FUNNY";
}
else {
$equalizer{$package[1]}++;
# to with the same version
if ($equalizer{$package[1]} > 1) {
$which_architecture = "FUNNY";
#print "$package[1] no need to do it again\n";
}
}
}
if ($which_architecture ne $archi) {
if ($which_architecture ne "all") {
# erasure time
##########
# GROUPS #
##########
# This keeps the groupindex proper
undef $ok;
(my $moggy = $package[1]) =~ s/\+/\\+/g;
#print "$distro $group == ", $group{$group}, " == $package[1]\n";
#print "$group -", $group{$group}, "\n";
my $check = ($group{$group} =~ m,(^.*)\s$moggy$,);
if ($check ne "") {
#print "DIST $disti $1\n";
$group{$group} = $1;
}
else {
delete $group{$group};
}
###########
# REPLACE #
###########
# this keeps deps correct
if (defined $pre_depends) {
pop(@REPLACE); pop(@REPLACE);
undef $pre_depends;
}
if (defined $depends) {
pop(@REPLACE); pop(@REPLACE);
undef $depends;
}
if (defined $recommends) {
pop(@REPLACE); pop(@REPLACE);
undef $recommends;
}
if (defined $suggests) {
pop(@REPLACE); pop(@REPLACE);
undef $suggests;
}
if (defined $conflicts) {
pop(@REPLACE); pop(@REPLACE);
undef $conflicts;
}
if (defined $provides) {
pop(@REPLACE); pop(@REPLACE);
undef $provides
}
if (defined $replaces) {
pop(@REPLACE); pop(@REPLACE);
undef $replaces;
}
##########
# STATUS #
##########
my $vion = substr($version,9);
$vion =~ s/\+/\\+/g;
my $pv = $moggy . "_" . $vion;
my $scheck = ($things =~ m,(^.*)\s$pv$,);
if ($scheck ne "") {
$things = $1;
}
else {
$things = "";
}
##print "$scheck $things\n\n";
# some of these things don't need to be undefed because
# they will be reset, because of the next.
undef $priority if defined $priority;
undef $section if defined $section;
undef $group if defined $group;
undef @essential if defined @essential;
undef $maintainer if defined $maintainer;
# undef $version if defined $version;
# undef @package if defined @package;
###print "GONE $package[1]\n";
#print "$things\n";
$goon = "yes";
next;
}
else {
#print "HUMM $which_architecture && $archi $package[1]\n";
undef $goon;
#$ok = "yes";
}
} # wrong architecture
else {
undef $goon;
}
}
#########################
# DIST CHECK & FILENAME #
#########################
elsif (/^Filename:/ && !defined $goon) {
chomp;
$filename = $_;
my @fields = split(/\//,$filename);
$distro = $fields[1];
my $archo;
if (defined $fields[3]) {
my $archos = $fields[3];
#$archos =~ /^.*-(\w*)$/;
$archos =~ /^binary-([-\w]*)$/;
$archo = $1;
}
else {
# experimental looks like project/experimental/packagename_ver
# so the architecture will be what is specified. Right now,
# the only architectures in experimental is i386 and all.
# This makes sense because all is the goal of Debian.
$arch =~ /-(.*)/; my $archi = $1;
$archo = $archi;
}
$dist =~ /-(.*)/; my $disti = $1;
$arch =~ /-(.*)/; my $archi = $1;
my($mainf, $contribf, $non_freef, $non_usf, $experimentalf);
if (defined $fields[3]) {
if (defined $main) {
$mainf = "yes" if $fields[2] eq $main;
}
if (defined $contrib) {
$contribf = "yes" if $fields[2] eq $contrib;
}
if (defined $non_free) {
$non_freef = "yes" if $fields[2] eq $non_free;
}
if (defined $non_us) {
$non_usf = "yes" if $fields[2] eq $non_us;
}
}
# the distribution experimental has no sections.
elsif ($fields[0] eq "Filename: project") {
$experimentalf = "yes" if $fields[1] eq "experimental";
}
#print "$filename && $distro && $archo && $fields[0]\n";
#print "$disti -> $distro && $archi -> $archo\n";
# project is experimental
# will determine whether this is right distribution and whether
# main, non-free, contrib, or non-us (not set up for traditional
# packages file) have been requested. options override the
# default
if ($disti eq $distro && $archi eq $archo && defined $mainf) {
my $filen = substr($_,10);
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "FN";
push(@FILENAME, "$nv");
push(@FILENAME, $filen);
$ok = "yes";
}
elsif ($disti eq $distro && $archi eq $archo && defined $contribf) {
my $filen = substr($_,10);
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "FN";
push(@FILENAME, "$nv");
push(@FILENAME, $filen);
$ok = "yes";
}
elsif ($disti eq $distro && $archi eq $archo && defined $non_freef) {
my $filen = substr($_,10);
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "FN";
push(@FILENAME, "$nv");
push(@FILENAME, $filen);
$ok = "yes";
}
elsif ($disti eq $distro && $archi eq $archo && defined $non_usf) {
my $filen = substr($_,10);
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "FN";
push(@FILENAME, "$nv");
push(@FILENAME, $filen);
$ok = "yes";
}
elsif ($disti eq $distro && $archi eq $archo
&& defined $experimentalf) {
my $filen = substr($_,10);
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "FN";
push(@FILENAME, "$nv");
push(@FILENAME, $filen);
$ok = "yes";
}
else {
# erasure time
##########
# GROUPS #
##########
# This keeps the groupindex proper
undef $ok;
# if (defined $package[1]) {
# $ppackage = $package[1];
# }
(my $moggy = $package[1]) =~ s/\+/\\+/g;
##print "$distro $group == ", $group{$group}, " == $package[1]";
#print "$group -", $group{$group}, "\n";
my $check = ($group{$group} =~ m,(^.*)\s$moggy$,);
if ($check ne "") {
#print "DIST $disti $1\n";
$group{$group} = $1;
}
else {
#print "JUST ONE", $group{$group}, "\n";
delete $group{$group};
}
# if (defined $group{$group}) {
# print "$check -> $group: ", $group{$group}, "\n";
# }
# print "\n";
###########
# REPLACE #
###########
# this keeps deps correct
if (defined $pre_depends) {
pop(@REPLACE); pop(@REPLACE);
undef $pre_depends;
}
if (defined $depends) {
pop(@REPLACE); pop(@REPLACE);
undef $depends;
}
if (defined $recommends) {
pop(@REPLACE); pop(@REPLACE);
undef $recommends;
}
if (defined $suggests) {
pop(@REPLACE); pop(@REPLACE);
undef $suggests;
}
if (defined $conflicts) {
pop(@REPLACE); pop(@REPLACE);
undef $conflicts;
}
if (defined $provides) {
pop(@REPLACE); pop(@REPLACE);
undef $provides
}
if (defined $replaces) {
pop(@REPLACE); pop(@REPLACE);
undef $replaces;
}
##########
# STATUS #
##########
my $vion = substr($version,9);
$vion =~ s/\+/\\+/g;
my $pv = $moggy . "_" . $vion;
my $scheck = ($things =~ m,(^.*)\s$pv$,);
if ($scheck ne "") {
$things = $1;
}
else {
$things = "";
}
###print "$scheck $things\n\n";
# some of these things don't need to be undefed because
# they will be reset, because of the next.
undef $priority if defined $priority;
undef $section if defined $section ;
undef $group if defined $group;
undef @essential if defined @essential;
undef $maintainer if defined $maintainer;
# undef $version if defined $version;
# undef @package if defined @package;
###print "GONE $package[1]\n";
#print "$things\n";
next;
} # wrong distribution
}
############
# ######## #
# # MAIN # #
# ######## #
############
elsif (defined $ok) {
##print "KEEP $package[1]\n";
if (/^Size:/) {
$size = $_;
chomp;
}
# -qp --md5sum can do this
# this part and the next work together for description.
elsif (/^MD5sum/) {
chomp;
my $md5sum = substr($_,8);
chomp $md5sum;
my $vion = substr($version,9);
my $nv = "$package[1]" . "_" . "$vion" . "MD";
push(@MD5SUM, "$nv");
push(@MD5SUM, $md5sum);
}
# We only need to go on here if it is the right architecture and
# distribution.
# To be combined with first fields. There are no packages
# missing this field, unlike a status file.
# defined either at architecture or filename.
elsif (m,Description:|^\s\w*|^\s\.\w*|^installed-size:|^revision:,){
# this solved an annoying problem
if (/^\n$/) {
next;
}
#print "$_ && $package[1]\n";
chomp $version;
$version =~ m,Version:\s(.*),; my $ending = $1;
my $many_lines = $_;
if ($_ !~ /^installed-size:|^revision:/) {
$count++;
if ($count == 1) {
if (defined $package[1]) {
#push(@dpackage,"$package[1]_$ending");
push(@description,"$package[1]_$ending");
}
}
if (defined($many_lines)) {
push(@ldescription,$many_lines);
}
} # end if ($_ !~ /^\n$/
elsif ($_ =~ /^installed-size|^revision:/) {
$count = 0;
# let's put each description into one scalar
my ($c, $cool);
if ($#ldescription != 0) {
for ($c = $#ldescription; $c >= 0; $c--) {
if ($c > 0) {
$cool = $ldescription[$c-1] .= $ldescription[$c];
}
} #end for
} # end if ($#ld
else {
$cool = $ldescription[0];
}
if (defined $cool) {
push(@description,$cool);
}
@ldescription = ();
} # end else
} # end elsif Description
#######################################
# installed-size: followed by source: #
#######################################
# if installed-size is at the end of Description, than source may
# follow. revision has been found once in the experimental
# distribution, but nothing was following it, this will have to be
# watched because the order isn't known, and installed-size and source
# will probably come into picture at some time.
if (/^installed-size:/ || /^revision:/) {
$installed_size = $_;
my $next = <PACKAGE>;
# source follows
if ($next =~ /^source:/) {
$source = $next;
chomp $source;
chomp ($version, $section);
$col1 = "Package: $package[1]";
# status time
my $yep = exist_sb(\%commands);
if (defined $yep) {
my($different,$same);
my $pname = $package[1];
if (defined $sb{$pname}) {
my ($vname,$gname,$priorname,$statusname) =
split(/\s/,"$sb{$pname}",4);
$statusname =~ s/:/ /g;
# a way to test
#$version = "Version: 1:5.0-2";
my $pver = substr($version,9);
my $cname = $pname . "_" . $pver;
if ($vname eq $cname) {
$status = "Status: $statusname\n";
$same = "yes"; undef($different);
}
else {
# here's where we get to do some comparisons
# we will have to compare sections. 1). may have changed
# 2). may be an unfair comparison free vs non-free, on the
# other-hand this should be in the person's awareness
# making the check. 1) will provide the answer to both.
$vname =~ m,^.*_(.*)$,;
my $ever = $1;
# print "$pname: $pver && $ever\n";
# $pver = new $ever = installed
my $oper = comparison($pver,$ever);
compare_versions($oper,$pver,$ever,$pname,\%commands)
if $commands->{"v"};
$status =
"Status: " . $oper . " $statusname ($ever)\n";
$different = "yes"; undef($same);
}
}
else {
$status = "Status: not-installed\n";
}
$col2 = $status;
untie %sb;
}
else {
$col2 = "Status: not-installed\n";
}
write PRETTY;
$col1 = $version;
$version =~ m,Version:\s(.*),;
# This creates a name -> version index in package.deb,
# and the statusindex.deb database which will serve to
# determine if the status has changed when --db or -i is
# ran.
push(@name, $package[1]);
push(@status, $package[1]);
$package[1] = "$package[1]_$1";
push(@name, $package[1]);
my $priory = substr($priority,10);
chomp $priory;
my $thimk = "$package[1] $group $priory";
push(@status, $thimk);
if(defined($essential[1])) {
$col2 = "Essential: $essential[1]";
@essential = ();
}
else {
$col2 = "Essential: no\n";
}
write PRETTY;
$col1 = $section;
$col2 = $priority;
write PRETTY;
#my $cool = $installed_size . $maintainer;
my $einstalled_size = substr($installed_size,16);
chomp $einstalled_size;
$col1 = "Installed-Size: $einstalled_size";
if (defined $source) {
my $esource = substr($source,8);
$col2 = "Source: $esource";
}
else {
$col2 = "";
}
write PRETTY;
undef $source;
$col1 = $size;
$col2 = "Architecture: $architecture\n";
write PRETTY;
if ($distro ne "experimental") {
$filename =~ m,^Filename: dists\/(\w*)\/.*$,;
print PRETTY "Distribution: $1\n";
print PRETTY $maintainer
}
else {
my $exp_dist = "experimental";
print PRETTY "Distribution: $exp_dist\n";
print PRETTY $maintainer
}
} # if $next =~ source
##############################################
# installed-size: or revision: by themselves #
##############################################
# source doesn't follow
elsif ($next =~ /^\n$/) {
chomp($version, $section);
$col1 = "Package: $package[1]";
# revision magic
if (/revision:/) {
$filename =~ m,.*/(.*)\.deb$,;
my $rr = $1 . "MD";
my $rver = substr($version,9);
my $prr = $package[1] . "_" . "$rver" . "MD REVISION";
push(@revision,$rr); push(@revision,$prr);
}
# status time
my $yep = exist_sb(\%commands);
if (defined $yep) {
my($different,$same);
my $pname = $package[1];
if (defined $sb{$pname}) {
my ($vname,$gname,$priorname,$statusname) =
split(/\s/,"$sb{$pname}",4);
$statusname =~ s/:/ /g;
# a way to test
#$version = "Version: 1:5.0-2";
my $pver = substr($version,9);
my $cname = $pname . "_" . $pver;
if ($vname eq $cname) {
$status = "Status: $statusname\n";
$same = "yes"; undef($different);
}
else {
# here's where we get to do some comparisons
# we will have to compare sections. 1). may have changed
# 2). may be an unfair comparison free vs non-free, on the
# other-hand this should be in the person's awareness
# making the check. 1) will provide the answer to both.
$vname =~ m,^.*_(.*)$,;
my $ever = $1;
# print "$pname: $pver && $ever\n";
# $pver = new $ever = installed
my $oper = comparison($pver,$ever);
compare_versions($oper,$pver,$ever,$pname,\%commands)
if $commands->{"v"};
$status =
"Status: " . $oper . " $statusname ($ever)\n";
$different = "yes"; undef($same);
}
}
else {
$status = "Status: not-installed\n";
}
$col2 = $status;
untie %sb;
} # if defined $yep
else {
$col2 = "Status: not-installed\n";
}
write PRETTY;
$col1 = $version;
$version =~ m,Version:\s(.*),;
# This creates a name -> version index in package.deb,
# and the statusindex.deb database which will serve to
# determine if the status has changed when --db or -i is
# ran.
push(@name, $package[1]);
push(@status, $package[1]);
$package[1] = "$package[1]_$1";
push(@name, $package[1]);
my $priory = substr($priority,10);
chomp $priory;
my $thimk = "$package[1] $group $priory";
push(@status, $thimk);
if(defined($essential[1])) {
$col2 = "Essential: $essential[1]";
@essential = ();
}
else {
$col2 = "Essential: no\n";
}
write PRETTY;
$col1 = $section;
$col2 = $priority;
write PRETTY;
#my $cool = $installed_size . $maintainer;
my $einstalled_size = substr($installed_size,16);
chomp $einstalled_size;
$col1 = "Installed-Size: $einstalled_size";
if (defined $source) {
my $esource = substr($source,8);
$col2 = "Source: $esource";
}
else {
$col2 = "";
}
write PRETTY;
undef $source;
$col1 = $size;
$col2 = "Architecture: $architecture\n";
write PRETTY;
if ($distro ne "experimental") {
$filename =~ m,^Filename: dists\/(\w*)\/.*$,;
print PRETTY "Distribution: $1\n";
print PRETTY $maintainer
}
else {
my $exp_dist = "experimental";
print PRETTY "Distribution: $exp_dist\n";
print PRETTY $maintainer
}
} # if $next =~ source
} # elsif installed-size
} # right arch and dist
} # end while (<PACKAGE>)
close(PRETTY);
# Let's put together the description with the rest of its fields.
open(FIELDS,"$format_deb");
while (<FIELDS>) {
push(@form,$_);
}
close(FIELDS);
$count = 0;
foreach (@form) {
push(@formly,$_);
my ($cool);
$count++;
if ($count == 7) {
my ($c, $cool);
if ($#formly != 0) {
for ($c = $#formly; $c >= 0; $c--) {
if ($c > 0) {
$cool = $formly[$c-1] .= $formly[$c];
}
} #end for
} # end if ($#ld
else {
$cool = $formly[0];
}
push(@complete,$cool);
@formly = ();
$count = 0;
}
}
foreach (@description) {
if ($count == 1) {
my $lingo = shift(@complete);
$lingo = $lingo . $_;
push(@Tdescription, $lingo);
$lingo = ();
$count = 1;
}
else {
push(@Tdescription, $_);
$count = 0;
}
$count++;
}
unlink($format_deb);
#untie $nping;
#undef %ngdb;
# We'll keep databases local so that md() doesn't get confused with
# database().
# Put the groups into the groupindex.deb database.
print "Not-installed Group Database is being made\n";
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
tie %ngb, 'DB_File', "$main::home$parent$library/ngroupindex$arch$dist.deb" or die "DB_File: $!";
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
tie %ngb, 'DB_File', "$main::home$parent$base/ngroupindex$arch$dist.deb" or die "DB_File: $!";
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
# assigning to HUMM solves a strange problem. semi-panic: attempt to dup
# freed string..internal newSVsv() routine was caused to duplicate a
# scalar that had been previously marked as free.
my @HUMM = %group;
%ngb = @HUMM;
untie %ngb;
undef %ngb;
undef %group;
undef @HUMM;
# Create the important status database.
print "Not-installed Status Database is being made\n";
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
tie %nsb, 'DB_File', "$main::home$parent$library/nstatusindex$arch$dist.deb" or die "DB_File: $!";
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
tie %nsb, 'DB_File', "$main::home$parent$base/nstatusindex$arch$dist.deb" or die "DB_File: $!";
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
push(@status,"/.");
if ($things =~ /^\s.*/) {
$things =~ s/^\s//;
}
push(@status,$things);
%nsb = @status;
untie %nsb;
undef %nsb;
undef @status;
undef $scount;
# Put everything into the package.deb database.
print "Not-installed Description Database is being made\n";
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
tie %ndb, 'DB_File', "$main::home$parent$library/npackages$arch$dist.deb" or die "DB_File: $!";
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
tie %ndb, 'DB_File', "$main::home$parent$base/npackages$arch$dist.deb" or die "DB_File: $!";
Rearranging things so that perl -I . can easily be used for development.
23 years ago
}
%ndb = (@name,@Tdescription,@conf,@REPLACE,@FILENAME,@MD5SUM,@revision);
untie %ndb;
undef @Tdescription;
undef @conf;
undef @REPLACE;
undef @FILENAME;
undef @MD5SUM;
undef @revision;
undef %ndb;
print scalar(localtime), "\n" if !$commands->{"Contents"};
} # ends sub not_installed
# This first looks in the immediate directory for statusindex.deb, if it
# isn't found here, it look in the default directory. It then returns
# undef, or initializes the database based on its findings.
sub exist_sb {
my ($commands) = @_;
my %commands = %$commands;
my $yep;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/statusindex.deb") {
Rearranging things so that perl -I . can easily be used for development.
23 years ago
$yep = "yes";
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$base/statusindex.deb") {
Rearranging things so that perl -I . can easily be used for development.
23 years ago
$yep = "yes";
}
}
if (!defined $yep) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$base/statusindex.deb") {
tie %sb, 'DB_File', "$main::home$parent$base/statusindex.deb"
Rearranging things so that perl -I . can easily be used for development.
23 years ago
or die "DB_File: $!";
return "yes";
}
else {
return;
}
}
elsif (defined $yep) {
sb(\%commands);
return "yes";
}
} # end sub exist_sb
sub sb {
my ($commands) = @_;
if (($commands->{"dbpath"} && $commands->{"root"}) ||
($commands->{"dbpath"} && !$commands->{"root"}) ||
(!$commands->{"dbpath"} && !$commands->{"root"})) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$library/statusindex.deb") {
tie %sb, 'DB_File', "$main::home$parent$library/statusindex.deb"
Rearranging things so that perl -I . can easily be used for development.
23 years ago
or die "DB_File: $!";
}
else {
return;
}
}
elsif (!$commands->{"dbpath"} && $commands->{"root"}) {
Now non-root users can create databases to access knowledge from swim.
23 years ago
if (-e "$main::home$parent$base/statusindex.deb") {
tie %sb, 'DB_File', "$main::home$parent$base/statusindex.deb"
Rearranging things so that perl -I . can easily be used for development.
23 years ago
or die "DB_File: $!";
}
else {
return;
}
}
} # end sub sb
# This creates the file filedir.deb using using the program longswim. The
# options --main, --contrib, non-free, non-us, or the default value is
# taken into consideration.
sub nmd {
my ($Contents,$commands) = @_;
my %commands = %$commands;
my ($dbpath, $root);
my ($main,$contrib,$non_free,$non_us);
$main = "yes" if $commands->{"main"};
$contrib = "yes" if $commands->{"contrib"};
$non_free = "yes" if $commands->{"non-free"};
$non_us = "yes" if $commands->{"non-us"};
if (!defined $main && !defined $contrib && !defined $non_free &&
!defined $non_us) {
foreach (@user_defined_section) {
if ($_ eq "main") {
$main = "yes";
}
elsif ($_ eq "contrib") {
$contrib = "yes";
}
elsif ($_ eq "non-free") {
$non_free = "yes";
}
elsif ($_ eq "non-us") {
$non_us = "yes";
}
}
}
$main = "no" if !defined($main);
$contrib = "no" if !defined($contrib);
$non_free = "no" if !defined($non_free);
$non_us = "no" if !defined($non_us);
my $Contents_mtime = (stat($Contents))[9];
$Contents = -B $Contents || $Contents =~ m,\.(gz|Z)$, ?
"$gzip -dc $Contents|" : "cat $Contents|";
my $contentsdb = finddb(\%commands);
my($arch,$dist) = which_archdist(\%commands);
my $contentsindex = "$contentsdb/ncontentsindex$arch$dist.deb";
my $npackages = "$contentsdb/npackages$arch$dist.deb";
print "Gathering the file(s)/dir(s) for the arch-dist section(s)\n";
# 0 1 2 3 4 5 6
system "$longswim",
$Contents, $contentsindex, $main, $contrib, $non_free, $non_us, $tmp,
$npackages, $gzip, $contentsdb, $Contents_mtime;
# longswim can be tested with something like this:
# /usr/lib/SWIM/longswim.alt "cat /USE/Contents|" \
# /test/ncontentsindex-i386-unstable.deb yes yes yes yes \
# /test /USE/npackages-i386-unstable.deb gzip /test 11111111
} # end sub nmd
1;