216 lines
5.6 KiB
Perl
216 lines
5.6 KiB
Perl
# Copyright © 1998 Richard Braakman
|
|
# Copyright © 1999 Darren Benham
|
|
# Copyright © 2000 Sean 'Shaleh' Perry
|
|
# Copyright © 2004 Frank Lichtenheld
|
|
# Copyright © 2006 Russ Allbery
|
|
# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
|
|
# Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org>
|
|
#
|
|
# This program is free software; you may 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 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, see <https://www.gnu.org/licenses/>.
|
|
|
|
=encoding utf8
|
|
|
|
=head1 NAME
|
|
|
|
Dpkg::Deps::KnownFacts - list of installed real and virtual packages
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This class represents a list of installed packages and a list of virtual
|
|
packages provided (by the set of installed packages).
|
|
|
|
=cut
|
|
|
|
package Dpkg::Deps::KnownFacts 2.00;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Dpkg::Version;
|
|
|
|
=head1 METHODS
|
|
|
|
=over 4
|
|
|
|
=item $facts = Dpkg::Deps::KnownFacts->new();
|
|
|
|
Creates a new object.
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my $this = shift;
|
|
my $class = ref($this) || $this;
|
|
my $self = {
|
|
pkg => {},
|
|
virtualpkg => {},
|
|
};
|
|
|
|
bless $self, $class;
|
|
return $self;
|
|
}
|
|
|
|
=item $facts->add_installed_package($package, $version, $arch, $multiarch)
|
|
|
|
Records that the given version of the package is installed. If
|
|
$version/$arch is undefined we know that the package is installed but we
|
|
don't know which version/architecture it is. $multiarch is the Multi-Arch
|
|
field of the package. If $multiarch is undef, it will be equivalent to
|
|
"Multi-Arch: no".
|
|
|
|
Note that $multiarch is only used if $arch is provided.
|
|
|
|
=cut
|
|
|
|
sub add_installed_package {
|
|
my ($self, $pkg, $ver, $arch, $multiarch) = @_;
|
|
my $p = {
|
|
package => $pkg,
|
|
version => $ver,
|
|
architecture => $arch,
|
|
multiarch => $multiarch // 'no',
|
|
};
|
|
|
|
$self->{pkg}{"$pkg:$arch"} = $p if defined $arch;
|
|
push @{$self->{pkg}{$pkg}}, $p;
|
|
}
|
|
|
|
=item $facts->add_provided_package($virtual, $relation, $version, $by)
|
|
|
|
Records that the "$by" package provides the $virtual package. $relation
|
|
and $version correspond to the associated relation given in the Provides
|
|
field (if present).
|
|
|
|
=cut
|
|
|
|
sub add_provided_package {
|
|
my ($self, $pkg, $rel, $ver, $by) = @_;
|
|
my $v = {
|
|
package => $pkg,
|
|
relation => $rel,
|
|
version => $ver,
|
|
provider => $by,
|
|
};
|
|
|
|
$self->{virtualpkg}{$pkg} //= [];
|
|
push @{$self->{virtualpkg}{$pkg}}, $v;
|
|
}
|
|
|
|
##
|
|
## The functions below are private to Dpkg::Deps::KnownFacts.
|
|
##
|
|
|
|
sub _find_package {
|
|
my ($self, $dep, $lackinfos) = @_;
|
|
my ($pkg, $archqual) = ($dep->{package}, $dep->{archqual});
|
|
|
|
return if not exists $self->{pkg}{$pkg};
|
|
|
|
my $host_arch = $dep->{host_arch} // Dpkg::Arch::get_host_arch();
|
|
my $build_arch = $dep->{build_arch} // Dpkg::Arch::get_build_arch();
|
|
|
|
foreach my $p (@{$self->{pkg}{$pkg}}) {
|
|
my $a = $p->{architecture};
|
|
my $ma = $p->{multiarch};
|
|
|
|
if (not defined $a) {
|
|
$$lackinfos = 1;
|
|
next;
|
|
}
|
|
if (not defined $archqual) {
|
|
return $p if $ma eq 'foreign';
|
|
return $p if $a eq $host_arch or $a eq 'all';
|
|
} elsif ($archqual eq 'any') {
|
|
return $p if $ma eq 'allowed';
|
|
} elsif ($archqual eq 'native') {
|
|
return if $ma eq 'foreign';
|
|
return $p if $a eq $build_arch or $a eq 'all';
|
|
} else {
|
|
return $p if $a eq $archqual;
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub _find_virtual_packages {
|
|
my ($self, $pkg) = @_;
|
|
|
|
return () if not exists $self->{virtualpkg}{$pkg};
|
|
return @{$self->{virtualpkg}{$pkg}};
|
|
}
|
|
|
|
=item $facts->evaluate_simple_dep()
|
|
|
|
This method is private and should not be used except from within L<Dpkg::Deps>.
|
|
|
|
=cut
|
|
|
|
sub evaluate_simple_dep {
|
|
my ($self, $dep) = @_;
|
|
my ($lackinfos, $pkg) = (0, $dep->{package});
|
|
|
|
my $p = $self->_find_package($dep, \$lackinfos);
|
|
if ($p) {
|
|
if (defined $dep->{relation}) {
|
|
if (defined $p->{version}) {
|
|
return 1 if version_compare_relation($p->{version},
|
|
$dep->{relation},
|
|
$dep->{version});
|
|
} else {
|
|
$lackinfos = 1;
|
|
}
|
|
} else {
|
|
return 1;
|
|
}
|
|
}
|
|
foreach my $virtpkg ($self->_find_virtual_packages($pkg)) {
|
|
next if defined $virtpkg->{relation} and
|
|
$virtpkg->{relation} ne REL_EQ;
|
|
|
|
if (defined $dep->{relation}) {
|
|
next if not defined $virtpkg->{version};
|
|
return 1 if version_compare_relation($virtpkg->{version},
|
|
$dep->{relation},
|
|
$dep->{version});
|
|
} else {
|
|
return 1;
|
|
}
|
|
}
|
|
return if $lackinfos;
|
|
return 0;
|
|
}
|
|
|
|
=back
|
|
|
|
=head1 CHANGES
|
|
|
|
=head2 Version 2.00 (dpkg 1.20.0)
|
|
|
|
Remove method: $facts->check_package().
|
|
|
|
=head2 Version 1.01 (dpkg 1.16.1)
|
|
|
|
New option: $facts->add_installed_package() now accepts 2
|
|
supplementary parameters ($arch and $multiarch).
|
|
|
|
Deprecated method: $facts->check_package() is obsolete,
|
|
it should not have been part of the public API.
|
|
|
|
=head2 Version 1.00 (dpkg 1.15.6)
|
|
|
|
Mark the module as public.
|
|
|
|
=cut
|
|
|
|
1;
|