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.

457 lines
12 KiB

# Package administration and research tool for Debian
# Copyright (C) 1999-2001 Jonathan D. Rosenbaum
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
package SWIM::Deps;
use strict;
use SWIM::Global qw(:Info);
use SWIM::DB_Library qw(:Xyz);
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(character s_character which_character the_character);
# the -T and siblings
# process the database for replaces
sub replaces {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "REP";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub replaces
# process the database for provides
sub provides {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "PRO";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub provides
# process the database for depends
sub depends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "DEP";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub depends
# process the database for replaces
sub pre_depends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "PRE";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub pre_depends
# process the database for replaces
sub recommends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "REC";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub recommends
# process the database for replaces
sub suggests {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "SUG";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub suggests
# process the database for replaces
sub conflicts {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "CON";
if (defined $db{$conf}) {
return $db{$conf};
}
else { return ""; }
}
untie %db;
} # end sub conflicts
#These subroutines are for cases where only packages related to the
# characteristics are printed out.
# process the database for replaces
sub s_replaces {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "REP";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_replaces
# process the database for provides
sub s_provides {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "PRO";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_provides
# process the database for depends
sub s_depends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "DEP";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_depends
# process the database for replaces
sub s_pre_depends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "PRE";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_pre_depends
# process the database for replaces
sub s_recommends {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "REC";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_recommends
# process the database for replaces
sub s_suggests {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "SUG";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_suggests
# process the database for replaces
sub s_conflicts {
my ($commands) = @_;
my %commands = %$commands;
!$commands->{"n"} ? dbi(\%commands) : ndb(\%commands);
if (defined $argument) {
my $conf = $argument . "CON";
if (defined $db{$conf}) {
return "$argument\n$db{$conf}";
}
else { return ""; }
}
untie %db;
} # end sub s_conflicts
# This figures out which characteristics (Replaces, Provides, etc) the
# options are pointing to. Isn't choosey, prints all packages
sub character {
my ($commands) = @_;
my %commands = %$commands;
# for singular cases
if ($commands->{"g"} && ($commands->{"T"} || $commands->{"pre_depends"} ||
$commands->{"depends"} || $commands->{"recommends"} ||
$commands->{"suggests"} || $commands->{"provides"} ||
$commands->{"replaces"} || $commands->{"conflicts"}) &&
!($commands->{"c"} || $commands->{"d"} || $commands->{"l"} ||
$commands->{"i"})) {
print "$argument\n";
}
# all the characteristics
if (defined $commands->{"T"}) {
print pre_depends(\%commands);
print depends(\%commands);
print recommends(\%commands);
print suggests(\%commands);
print provides(\%commands);
print replaces(\%commands);
print conflicts(\%commands);
}
else {
if (defined $commands->{"pre_depends"}) {
print pre_depends(\%commands);
delete $commands{"pre_depends"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"depends"}) {
print depends(\%commands);
delete $commands{"depends"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"recommends"}) {
print recommends(\%commands);
delete $commands{"recommends"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"suggests"}) {
print suggests(\%commands);
delete $commands{"suggests"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"replaces"}) {
print replaces(\%commands);
delete $commands{"replaces"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"provides"}) {
print provides(\%commands);
delete $commands{"provides"} if !($commands->{"S"} || $commands->{"g"});
}
if (defined $commands->{"conflicts"}) {
print conflicts(\%commands);
delete $commands{"conflicts"} if !($commands->{"S"} || $commands->{"g"});
}
}
} # end sub character
# Prints out the characteristics only for the packages which have them.
sub s_character {
my ($commands) = @_;
my %commands = %$commands;
if ($commands->{"pre_depends"}) {
print s_pre_depends(\%commands);
delete $commands{"pre_depends"};
if (s_pre_depends(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"depends"}) {
print s_depends(\%commands);
delete $commands{"depends"};
if (s_depends(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"recommends"}) {
print s_recommends(\%commands);
delete $commands{"recommends"};
if (s_recommends(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"suggests"}) {
print s_suggests(\%commands);
delete $commands{"suggests"};
if (s_suggests(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"replaces"}) {
print s_replaces(\%commands);
delete $commands{"replaces"};
if (s_replaces(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"provides"}) {
print s_provides(\%commands);
delete $commands{"provides"};
if (s_provides(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
elsif ($commands->{"conflicts"}) {
print s_conflicts(\%commands);
delete $commands{"conflicts"};
if (s_conflicts(\%commands) ne "") {
character(\%commands);
}
# else { s_character(\%commands) }
}
# all the characteristics
if ($commands->{"T"}) {
print s_pre_depends(\%commands);
print s_depends(\%commands);
print s_recommends(\%commands);
print s_suggests(\%commands);
print s_provides(\%commands);
print s_replaces(\%commands);
print s_conflicts(\%commands);
}
} # end sub s_character
# helps to determine if character(\%commands) should be used
sub which_character {
my ($commands) = @_;
if ($commands->{"pre_depends"} || $commands->{"depends"} ||
$commands->{"recommends"} || $commands->{"suggests"} ||
$commands->{"replaces"} || $commands->{"provides"} ||
$commands->{"conflicts"}) {
return 1;
}
} # end sub which_character
# This runs a test to see whether or not the characters being asked for
# apply to this package.
sub the_character {
my ($commands) = @_;
my %commands = %$commands;
if (defined $commands->{"pre_depends"}) {
if (pre_depends(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"depends"}) {
if (depends(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"recommends"}) {
if (recommends(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"suggests"}) {
if (suggests(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"replaces"}) {
if (replaces(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"provides"}) {
if (provides(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
if (defined $commands->{"conflicts"}) {
if (conflicts(\%commands) eq "") {
print "";
}
else { return "ok"; }
}
} # end sub the_character
1;