| Index: third_party/dpkg-dev/scripts/Dpkg/Deps.pm
|
| diff --git a/third_party/dpkg-dev/scripts/Dpkg/Deps.pm b/third_party/dpkg-dev/scripts/Dpkg/Deps.pm
|
| new file mode 100644
|
| index 0000000000000000000000000000000000000000..7bc18153c11220f986758c28d38f5206802817d1
|
| --- /dev/null
|
| +++ b/third_party/dpkg-dev/scripts/Dpkg/Deps.pm
|
| @@ -0,0 +1,1468 @@
|
| +# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
|
| +# Copyright © 2012 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/>.
|
| +#########################################################################
|
| +# Several parts are inspired by lib/Dep.pm from lintian (same license)
|
| +#
|
| +# Copyright © 1998 Richard Braakman
|
| +# Portions Copyright © 1999 Darren Benham
|
| +# Portions Copyright © 2000 Sean 'Shaleh' Perry
|
| +# Portions Copyright © 2004 Frank Lichtenheld
|
| +# Portions Copyright © 2006 Russ Allbery
|
| +
|
| +package Dpkg::Deps;
|
| +
|
| +=encoding utf8
|
| +
|
| +=head1 NAME
|
| +
|
| +Dpkg::Deps - parse and manipulate dependencies of Debian packages
|
| +
|
| +=head1 DESCRIPTION
|
| +
|
| +The Dpkg::Deps module provides objects implementing various types of
|
| +dependencies.
|
| +
|
| +The most important function is deps_parse(), it turns a dependency line in
|
| +a set of Dpkg::Deps::{Simple,AND,OR,Union} objects depending on the case.
|
| +
|
| +=head1 FUNCTIONS
|
| +
|
| +All the deps_* functions are exported by default.
|
| +
|
| +=over 4
|
| +
|
| +=cut
|
| +
|
| +use strict;
|
| +use warnings;
|
| +
|
| +our $VERSION = '1.02';
|
| +
|
| +use Dpkg::Version;
|
| +use Dpkg::Arch qw(get_host_arch get_build_arch);
|
| +use Dpkg::BuildProfiles qw(get_build_profiles);
|
| +use Dpkg::ErrorHandling;
|
| +use Dpkg::Gettext;
|
| +
|
| +use Exporter qw(import);
|
| +our @EXPORT = qw(deps_concat deps_parse deps_eval_implication deps_compare);
|
| +
|
| +=item deps_eval_implication($rel_p, $v_p, $rel_q, $v_q)
|
| +
|
| +($rel_p, $v_p) and ($rel_q, $v_q) express two dependencies as (relation,
|
| +version). The relation variable can have the following values that are
|
| +exported by Dpkg::Version: REL_EQ, REL_LT, REL_LE, REL_GT, REL_GT.
|
| +
|
| +This functions returns 1 if the "p" dependency implies the "q"
|
| +dependency. It returns 0 if the "p" dependency implies that "q" is
|
| +not satisfied. It returns undef when there's no implication.
|
| +
|
| +The $v_p and $v_q parameter should be Dpkg::Version objects.
|
| +
|
| +=cut
|
| +
|
| +sub deps_eval_implication {
|
| + my ($rel_p, $v_p, $rel_q, $v_q) = @_;
|
| +
|
| + # If versions are not valid, we can't decide of any implication
|
| + return unless defined($v_p) and $v_p->is_valid();
|
| + return unless defined($v_q) and $v_q->is_valid();
|
| +
|
| + # q wants an exact version, so p must provide that exact version. p
|
| + # disproves q if q's version is outside the range enforced by p.
|
| + if ($rel_q eq REL_EQ) {
|
| + if ($rel_p eq REL_LT) {
|
| + return ($v_p <= $v_q) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_LE) {
|
| + return ($v_p < $v_q) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_GT) {
|
| + return ($v_p >= $v_q) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_GE) {
|
| + return ($v_p > $v_q) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_EQ) {
|
| + return ($v_p == $v_q);
|
| + }
|
| + }
|
| +
|
| + # A greater than clause may disprove a less than clause. An equal
|
| + # cause might as well. Otherwise, if
|
| + # p's clause is <<, <=, or =, the version must be <= q's to imply q.
|
| + if ($rel_q eq REL_LE) {
|
| + if ($rel_p eq REL_GT) {
|
| + return ($v_p >= $v_q) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_GE) {
|
| + return ($v_p > $v_q) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_EQ) {
|
| + return ($v_p <= $v_q) ? 1 : 0;
|
| + } else { # <<, <=
|
| + return ($v_p <= $v_q) ? 1 : undef;
|
| + }
|
| + }
|
| +
|
| + # Similar, but << is stronger than <= so p's version must be << q's
|
| + # version if the p relation is <= or =.
|
| + if ($rel_q eq REL_LT) {
|
| + if ($rel_p eq REL_GT or $rel_p eq REL_GE) {
|
| + return ($v_p >= $v_p) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_LT) {
|
| + return ($v_p <= $v_q) ? 1 : undef;
|
| + } elsif ($rel_p eq REL_EQ) {
|
| + return ($v_p < $v_q) ? 1 : 0;
|
| + } else { # <<, <=
|
| + return ($v_p < $v_q) ? 1 : undef;
|
| + }
|
| + }
|
| +
|
| + # Same logic as above, only inverted.
|
| + if ($rel_q eq REL_GE) {
|
| + if ($rel_p eq REL_LT) {
|
| + return ($v_p <= $v_q) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_LE) {
|
| + return ($v_p < $v_q) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_EQ) {
|
| + return ($v_p >= $v_q) ? 1 : 0;
|
| + } else { # >>, >=
|
| + return ($v_p >= $v_q) ? 1 : undef;
|
| + }
|
| + }
|
| + if ($rel_q eq REL_GT) {
|
| + if ($rel_p eq REL_LT or $rel_p eq REL_LE) {
|
| + return ($v_p <= $v_q) ? 0 : undef;
|
| + } elsif ($rel_p eq REL_GT) {
|
| + return ($v_p >= $v_q) ? 1 : undef;
|
| + } elsif ($rel_p eq REL_EQ) {
|
| + return ($v_p > $v_q) ? 1 : 0;
|
| + } else {
|
| + return ($v_p > $v_q) ? 1 : undef;
|
| + }
|
| + }
|
| +
|
| + return;
|
| +}
|
| +
|
| +=item my $dep = deps_concat(@dep_list)
|
| +
|
| +This function concatenates multiple dependency lines into a single line,
|
| +joining them with ", " if appropriate, and always returning a valid string.
|
| +
|
| +=cut
|
| +
|
| +sub deps_concat {
|
| + my (@dep_list) = @_;
|
| +
|
| + return join(', ', grep { defined $_ } @dep_list);
|
| +}
|
| +
|
| +=item my $dep = deps_parse($line, %options)
|
| +
|
| +This function parses the dependency line and returns an object, either a
|
| +Dpkg::Deps::AND or a Dpkg::Deps::Union. Various options can alter the
|
| +behaviour of that function.
|
| +
|
| +=over 4
|
| +
|
| +=item use_arch (defaults to 1)
|
| +
|
| +Take into account the architecture restriction part of the dependencies.
|
| +Set to 0 to completely ignore that information.
|
| +
|
| +=item host_arch (defaults to the current architecture)
|
| +
|
| +Define the host architecture. By default it uses
|
| +Dpkg::Arch::get_host_arch() to identify the proper architecture.
|
| +
|
| +=item build_arch (defaults to the current architecture)
|
| +
|
| +Define the build architecture. By default it uses
|
| +Dpkg::Arch::get_build_arch() to identify the proper architecture.
|
| +
|
| +=item reduce_arch (defaults to 0)
|
| +
|
| +If set to 1, ignore dependencies that do not concern the current host
|
| +architecture. This implicitely strips off the architecture restriction
|
| +list so that the resulting dependencies are directly applicable to the
|
| +current architecture.
|
| +
|
| +=item use_profiles (defaults to 1)
|
| +
|
| +Take into account the profile restriction part of the dependencies. Set
|
| +to 0 to completely ignore that information.
|
| +
|
| +=item build_profiles (defaults to no profile)
|
| +
|
| +Define the active build profiles. By default no profile is defined.
|
| +
|
| +=item reduce_profiles (defaults to 0)
|
| +
|
| +If set to 1, ignore dependencies that do not concern the current build
|
| +profile. This implicitly strips off the profile restriction list so
|
| +that the resulting dependencies are directly applicable to the current
|
| +profiles.
|
| +
|
| +=item reduce_restrictions (defaults to 0)
|
| +
|
| +If set to 1, ignore dependencies that do not concern the current set of
|
| +restrictions. This implicitly strips off any restriction list so that the
|
| +resulting dependencies are directly applicable to the current restriction.
|
| +This currently implies C<reduce_arch> and C<reduce_profiles>, and overrides
|
| +them if set.
|
| +
|
| +=item union (defaults to 0)
|
| +
|
| +If set to 1, returns a Dpkg::Deps::Union instead of a Dpkg::Deps::AND. Use
|
| +this when parsing non-dependency fields like Conflicts.
|
| +
|
| +=item build_dep (defaults to 0)
|
| +
|
| +If set to 1, allow build-dep only arch qualifiers, that is “:native”.
|
| +This should be set whenever working with build-deps.
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +sub deps_parse {
|
| + my $dep_line = shift;
|
| + my %options = (@_);
|
| + $options{use_arch} = 1 if not exists $options{use_arch};
|
| + $options{reduce_arch} = 0 if not exists $options{reduce_arch};
|
| + $options{host_arch} = get_host_arch() if not exists $options{host_arch};
|
| + $options{build_arch} = get_build_arch() if not exists $options{build_arch};
|
| + $options{use_profiles} = 1 if not exists $options{use_profiles};
|
| + $options{reduce_profiles} = 0 if not exists $options{reduce_profiles};
|
| + $options{build_profiles} = [ get_build_profiles() ]
|
| + if not exists $options{build_profiles};
|
| + $options{reduce_restrictions} = 0 if not exists $options{reduce_restrictions};
|
| + $options{union} = 0 if not exists $options{union};
|
| + $options{build_dep} = 0 if not exists $options{build_dep};
|
| +
|
| + if ($options{reduce_restrictions}) {
|
| + $options{reduce_arch} = 1;
|
| + $options{reduce_profiles} = 1;
|
| + }
|
| +
|
| + # Strip trailing/leading spaces
|
| + $dep_line =~ s/^\s+//;
|
| + $dep_line =~ s/\s+$//;
|
| +
|
| + my @dep_list;
|
| + foreach my $dep_and (split(/\s*,\s*/m, $dep_line)) {
|
| + my @or_list = ();
|
| + foreach my $dep_or (split(/\s*\|\s*/m, $dep_and)) {
|
| + my $dep_simple = Dpkg::Deps::Simple->new($dep_or, host_arch =>
|
| + $options{host_arch},
|
| + build_arch =>
|
| + $options{build_arch},
|
| + build_dep =>
|
| + $options{build_dep});
|
| + if (not defined $dep_simple->{package}) {
|
| + warning(_g("can't parse dependency %s"), $dep_or);
|
| + return;
|
| + }
|
| + $dep_simple->{arches} = undef if not $options{use_arch};
|
| + if ($options{reduce_arch}) {
|
| + $dep_simple->reduce_arch($options{host_arch});
|
| + next if not $dep_simple->arch_is_concerned($options{host_arch});
|
| + }
|
| + $dep_simple->{restrictions} = undef if not $options{use_profiles};
|
| + if ($options{reduce_profiles}) {
|
| + $dep_simple->reduce_profiles($options{build_profiles});
|
| + next if not $dep_simple->profile_is_concerned($options{build_profiles});
|
| + }
|
| + push @or_list, $dep_simple;
|
| + }
|
| + next if not @or_list;
|
| + if (scalar @or_list == 1) {
|
| + push @dep_list, $or_list[0];
|
| + } else {
|
| + my $dep_or = Dpkg::Deps::OR->new();
|
| + $dep_or->add($_) foreach (@or_list);
|
| + push @dep_list, $dep_or;
|
| + }
|
| + }
|
| + my $dep_and;
|
| + if ($options{union}) {
|
| + $dep_and = Dpkg::Deps::Union->new();
|
| + } else {
|
| + $dep_and = Dpkg::Deps::AND->new();
|
| + }
|
| + foreach my $dep (@dep_list) {
|
| + if ($options{union} and not $dep->isa('Dpkg::Deps::Simple')) {
|
| + warning(_g('an union dependency can only contain simple dependencies'));
|
| + return;
|
| + }
|
| + $dep_and->add($dep);
|
| + }
|
| + return $dep_and;
|
| +}
|
| +
|
| +=item deps_compare($a, $b)
|
| +
|
| +Implements a comparison operator between two dependency objects.
|
| +This function is mainly used to implement the sort() method.
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +my %relation_ordering = (
|
| + undef => 0,
|
| + REL_GE() => 1,
|
| + REL_GT() => 2,
|
| + REL_EQ() => 3,
|
| + REL_LT() => 4,
|
| + REL_LE() => 5,
|
| +);
|
| +
|
| +sub deps_compare {
|
| + my ($a, $b) = @_;
|
| + return -1 if $a->is_empty();
|
| + return 1 if $b->is_empty();
|
| + while ($a->isa('Dpkg::Deps::Multiple')) {
|
| + return -1 if $a->is_empty();
|
| + my @deps = $a->get_deps();
|
| + $a = $deps[0];
|
| + }
|
| + while ($b->isa('Dpkg::Deps::Multiple')) {
|
| + return 1 if $b->is_empty();
|
| + my @deps = $b->get_deps();
|
| + $b = $deps[0];
|
| + }
|
| + my $ar = defined($a->{relation}) ? $a->{relation} : 'undef';
|
| + my $br = defined($b->{relation}) ? $b->{relation} : 'undef';
|
| + return (($a->{package} cmp $b->{package}) ||
|
| + ($relation_ordering{$ar} <=> $relation_ordering{$br}) ||
|
| + ($a->{version} cmp $b->{version}));
|
| +}
|
| +
|
| +
|
| +package Dpkg::Deps::Simple;
|
| +
|
| +=head1 OBJECTS - Dpkg::Deps::*
|
| +
|
| +There are several kind of dependencies. A Dpkg::Deps::Simple dependency
|
| +represents a single dependency statement (it relates to one package only).
|
| +Dpkg::Deps::Multiple dependencies are built on top of this object
|
| +and combine several dependencies in a different manners. Dpkg::Deps::AND
|
| +represents the logical "AND" between dependencies while Dpkg::Deps::OR
|
| +represents the logical "OR". Dpkg::Deps::Multiple objects can contain
|
| +Dpkg::Deps::Simple object as well as other Dpkg::Deps::Multiple objects.
|
| +
|
| +In practice, the code is only meant to handle the realistic cases which,
|
| +given Debian's dependencies structure, imply those restrictions: AND can
|
| +contain Simple or OR objects, OR can only contain Simple objects.
|
| +
|
| +Dpkg::Deps::KnownFacts is a special object that is used while evaluating
|
| +dependencies and while trying to simplify them. It represents a set of
|
| +installed packages along with the virtual packages that they might
|
| +provide.
|
| +
|
| +=head2 COMMON FUNCTIONS
|
| +
|
| +=over 4
|
| +
|
| +=item $dep->is_empty()
|
| +
|
| +Returns true if the dependency is empty and doesn't contain any useful
|
| +information. This is true when a Dpkg::Deps::Simple object has not yet
|
| +been initialized or when a (descendant of) Dpkg::Deps::Multiple contains
|
| +an empty list of dependencies.
|
| +
|
| +=item $dep->get_deps()
|
| +
|
| +Returns a list of sub-dependencies. For Dpkg::Deps::Simple it returns
|
| +itself.
|
| +
|
| +=item $dep->output([$fh])
|
| +
|
| +=item "$dep"
|
| +
|
| +Returns a string representing the dependency. If $fh is set, it prints
|
| +the string to the filehandle.
|
| +
|
| +=item $dep->implies($other_dep)
|
| +
|
| +Returns 1 when $dep implies $other_dep. Returns 0 when $dep implies
|
| +NOT($other_dep). Returns undef when there's no implication. $dep and
|
| +$other_dep do not need to be of the same type.
|
| +
|
| +=item $dep->sort()
|
| +
|
| +Sorts alphabetically the internal list of dependencies. It's a no-op for
|
| +Dpkg::Deps::Simple objects.
|
| +
|
| +=item $dep->arch_is_concerned($arch)
|
| +
|
| +Returns true if the dependency applies to the indicated architecture. For
|
| +multiple dependencies, it returns true if at least one of the
|
| +sub-dependencies apply to this architecture.
|
| +
|
| +=item $dep->reduce_arch($arch)
|
| +
|
| +Simplifies the dependency to contain only information relevant to the given
|
| +architecture. A Dpkg::Deps::Simple object can be left empty after this
|
| +operation. For Dpkg::Deps::Multiple objects, the non-relevant
|
| +sub-dependencies are simply removed.
|
| +
|
| +This trims off the architecture restriction list of Dpkg::Deps::Simple
|
| +objects.
|
| +
|
| +=item $dep->get_evaluation($facts)
|
| +
|
| +Evaluates the dependency given a list of installed packages and a list of
|
| +virtual packages provided. Those lists are part of the
|
| +Dpkg::Deps::KnownFacts object given as parameters.
|
| +
|
| +Returns 1 when it's true, 0 when it's false, undef when some information
|
| +is lacking to conclude.
|
| +
|
| +=item $dep->simplify_deps($facts, @assumed_deps)
|
| +
|
| +Simplifies the dependency as much as possible given the list of facts (see
|
| +object Dpkg::Deps::KnownFacts) and a list of other dependencies that are
|
| +known to be true.
|
| +
|
| +=item $dep->has_arch_restriction()
|
| +
|
| +For a simple dependency, returns the package name if the dependency
|
| +applies only to a subset of architectures. For multiple dependencies, it
|
| +returns the list of package names that have such a restriction.
|
| +
|
| +=item $dep->reset()
|
| +
|
| +Clears any dependency information stored in $dep so that $dep->is_empty()
|
| +returns true.
|
| +
|
| +=back
|
| +
|
| +=head2 Dpkg::Deps::Simple
|
| +
|
| +Such an object has four interesting properties:
|
| +
|
| +=over 4
|
| +
|
| +=item package
|
| +
|
| +The package name (can be undef if the dependency has not been initialized
|
| +or if the simplification of the dependency lead to its removal).
|
| +
|
| +=item relation
|
| +
|
| +The relational operator: "=", "<<", "<=", ">=" or ">>". It can be
|
| +undefined if the dependency had no version restriction. In that case the
|
| +following field is also undefined.
|
| +
|
| +=item version
|
| +
|
| +The version.
|
| +
|
| +=item arches
|
| +
|
| +The list of architectures where this dependency is applicable. It's
|
| +undefined when there's no restriction, otherwise it's an
|
| +array ref. It can contain an exclusion list, in that case each
|
| +architecture is prefixed with an exclamation mark.
|
| +
|
| +=item archqual
|
| +
|
| +The arch qualifier of the dependency (can be undef if there's none).
|
| +In the dependency "python:any (>= 2.6)", the arch qualifier is "any".
|
| +
|
| +=back
|
| +
|
| +=head3 METHODS
|
| +
|
| +=over 4
|
| +
|
| +=item $simple_dep->parse_string('dpkg-dev (>= 1.14.8) [!hurd-i386]')
|
| +
|
| +Parses the dependency and modifies internal properties to match the parsed
|
| +dependency.
|
| +
|
| +=item $simple_dep->merge_union($other_dep)
|
| +
|
| +Returns true if $simple_dep could be modified to represent the union of
|
| +both dependencies. Otherwise returns false.
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +use strict;
|
| +use warnings;
|
| +
|
| +use Carp;
|
| +
|
| +use Dpkg::Arch qw(debarch_is);
|
| +use Dpkg::Version;
|
| +use Dpkg::ErrorHandling;
|
| +use Dpkg::Gettext;
|
| +use Dpkg::Util qw(:list);
|
| +
|
| +use parent qw(Dpkg::Interface::Storable);
|
| +
|
| +sub new {
|
| + my ($this, $arg, %opts) = @_;
|
| + my $class = ref($this) || $this;
|
| + my $self = {};
|
| + bless $self, $class;
|
| + $self->reset();
|
| + $self->{host_arch} = $opts{host_arch} || Dpkg::Arch::get_host_arch();
|
| + $self->{build_arch} = $opts{build_arch} || Dpkg::Arch::get_build_arch();
|
| + $self->{build_dep} = $opts{build_dep} || 0;
|
| + $self->parse_string($arg) if defined($arg);
|
| + return $self;
|
| +}
|
| +
|
| +sub reset {
|
| + my ($self) = @_;
|
| + $self->{package} = undef;
|
| + $self->{relation} = undef;
|
| + $self->{version} = undef;
|
| + $self->{arches} = undef;
|
| + $self->{archqual} = undef;
|
| + $self->{restrictions} = undef;
|
| +}
|
| +
|
| +sub parse {
|
| + my ($self, $fh, $desc) = @_;
|
| + my $line = <$fh>;
|
| + chomp($line);
|
| + return $self->parse_string($line);
|
| +}
|
| +
|
| +sub parse_string {
|
| + my ($self, $dep) = @_;
|
| + return if not $dep =~
|
| + m{^\s* # skip leading whitespace
|
| + ([a-zA-Z0-9][a-zA-Z0-9+.-]*) # package name
|
| + (?: # start of optional part
|
| + : # colon for architecture
|
| + ([a-zA-Z0-9][a-zA-Z0-9-]*) # architecture name
|
| + )? # end of optional part
|
| + (?: # start of optional part
|
| + \s* \( # open parenthesis for version part
|
| + \s* (<<|<=|=|>=|>>|<|>) # relation part
|
| + \s* (.*?) # do not attempt to parse version
|
| + \s* \) # closing parenthesis
|
| + )? # end of optional part
|
| + (?: # start of optional architecture
|
| + \s* \[ # open bracket for architecture
|
| + \s* (.*?) # don't parse architectures now
|
| + \s* \] # closing bracket
|
| + )? # end of optional architecture
|
| + (?: # start of optional restriction
|
| + \s* < # open bracket for restriction
|
| + \s* (.*?) # don't parse restrictions now
|
| + \s* > # closing bracket
|
| + )? # end of optional restriction
|
| + \s*$ # trailing spaces at end
|
| + }x;
|
| + if (defined($2)) {
|
| + return if $2 eq 'native' and not $self->{build_dep};
|
| + $self->{archqual} = $2;
|
| + }
|
| + $self->{package} = $1;
|
| + $self->{relation} = version_normalize_relation($3) if defined($3);
|
| + if (defined($4)) {
|
| + $self->{version} = Dpkg::Version->new($4);
|
| + }
|
| + if (defined($5)) {
|
| + $self->{arches} = [ split(/\s+/, $5) ];
|
| + }
|
| + if (defined($6)) {
|
| + $self->{restrictions} = [ map { lc } split /\s+/, $6 ];
|
| + }
|
| +}
|
| +
|
| +sub output {
|
| + my ($self, $fh) = @_;
|
| + my $res = $self->{package};
|
| + if (defined($self->{archqual})) {
|
| + $res .= ':' . $self->{archqual};
|
| + }
|
| + if (defined($self->{relation})) {
|
| + $res .= ' (' . $self->{relation} . ' ' . $self->{version} . ')';
|
| + }
|
| + if (defined($self->{arches})) {
|
| + $res .= ' [' . join(' ', @{$self->{arches}}) . ']';
|
| + }
|
| + if (defined($self->{restrictions})) {
|
| + $res .= ' <' . join(' ', @{$self->{restrictions}}) . '>';
|
| + }
|
| + if (defined($fh)) {
|
| + print { $fh } $res;
|
| + }
|
| + return $res;
|
| +}
|
| +
|
| +# _arch_is_superset(\@p, \@q)
|
| +#
|
| +# Returns true if the arch list @p is a superset of arch list @q.
|
| +# The arguments can also be undef in case there's no explicit architecture
|
| +# restriction.
|
| +sub _arch_is_superset {
|
| + my ($p, $q) = @_;
|
| + my $p_arch_neg = defined($p) && $p->[0] =~ /^!/;
|
| + my $q_arch_neg = defined($q) && $q->[0] =~ /^!/;
|
| +
|
| + # If "p" has no arches, it is a superset of q and we should fall through
|
| + # to the version check.
|
| + if (not defined $p) {
|
| + return 1;
|
| + }
|
| +
|
| + # If q has no arches, it is a superset of p and there are no useful
|
| + # implications.
|
| + elsif (not defined $q) {
|
| + return 0;
|
| + }
|
| +
|
| + # Both have arches. If neither are negated, we know nothing useful
|
| + # unless q is a subset of p.
|
| + elsif (not $p_arch_neg and not $q_arch_neg) {
|
| + my %p_arches = map { $_ => 1 } @{$p};
|
| + my $subset = 1;
|
| + for my $arch (@{$q}) {
|
| + $subset = 0 unless $p_arches{$arch};
|
| + }
|
| + return 0 unless $subset;
|
| + }
|
| +
|
| + # If both are negated, we know nothing useful unless p is a subset of
|
| + # q (and therefore has fewer things excluded, and therefore is more
|
| + # general).
|
| + elsif ($p_arch_neg and $q_arch_neg) {
|
| + my %q_arches = map { $_ => 1 } @{$q};
|
| + my $subset = 1;
|
| + for my $arch (@{$p}) {
|
| + $subset = 0 unless $q_arches{$arch};
|
| + }
|
| + return 0 unless $subset;
|
| + }
|
| +
|
| + # If q is negated and p isn't, we'd need to know the full list of
|
| + # arches to know if there's any relationship, so bail.
|
| + elsif (not $p_arch_neg and $q_arch_neg) {
|
| + return 0;
|
| + }
|
| +
|
| + # If p is negated and q isn't, q is a subset of p if none of the
|
| + # negated arches in p are present in q.
|
| + elsif ($p_arch_neg and not $q_arch_neg) {
|
| + my %q_arches = map { $_ => 1 } @{$q};
|
| + my $subset = 1;
|
| + for my $arch (@{$p}) {
|
| + $subset = 0 if $q_arches{substr($arch, 1)};
|
| + }
|
| + return 0 unless $subset;
|
| + }
|
| + return 1;
|
| +}
|
| +
|
| +# _arch_qualifier_allows_implication($p, $q)
|
| +#
|
| +# Returns true if the arch qualifier $p and $q are compatible with the
|
| +# implication $p -> $q, false otherwise. $p/$q can be
|
| +# undef/"any"/"native" or an architecture string.
|
| +sub _arch_qualifier_allows_implication {
|
| + my ($p, $q) = @_;
|
| + if (defined $p and $p eq 'any') {
|
| + return 1 if defined $q and $q eq 'any';
|
| + return 0;
|
| + } elsif (defined $p and $p eq 'native') {
|
| + return 1 if defined $q and ($q eq 'any' or $q eq 'native');
|
| + return 0;
|
| + } elsif (defined $p) {
|
| + return 1 if defined $q and ($p eq $q or $q eq 'any');
|
| + return 0;
|
| + } else {
|
| + return 0 if defined $q and $q ne 'any' and $q ne 'native';
|
| + return 1;
|
| + }
|
| +}
|
| +
|
| +# Returns true if the dependency in parameter can deduced from the current
|
| +# dependency. Returns false if it can be negated. Returns undef if nothing
|
| +# can be concluded.
|
| +sub implies {
|
| + my ($self, $o) = @_;
|
| + if ($o->isa('Dpkg::Deps::Simple')) {
|
| + # An implication is only possible on the same package
|
| + return if $self->{package} ne $o->{package};
|
| +
|
| + # Our architecture set must be a superset of the architectures for
|
| + # o, otherwise we can't conclude anything.
|
| + return unless _arch_is_superset($self->{arches}, $o->{arches});
|
| +
|
| + # The arch qualifier must not forbid an implication
|
| + return unless _arch_qualifier_allows_implication($self->{archqual},
|
| + $o->{archqual});
|
| +
|
| + # If o has no version clause, then our dependency is stronger
|
| + return 1 if not defined $o->{relation};
|
| + # If o has a version clause, we must also have one, otherwise there
|
| + # can't be an implication
|
| + return if not defined $self->{relation};
|
| +
|
| + return Dpkg::Deps::deps_eval_implication($self->{relation},
|
| + $self->{version}, $o->{relation}, $o->{version});
|
| +
|
| + } elsif ($o->isa('Dpkg::Deps::AND')) {
|
| + # TRUE: Need to imply all individual elements
|
| + # FALSE: Need to NOT imply at least one individual element
|
| + my $res = 1;
|
| + foreach my $dep ($o->get_deps()) {
|
| + my $implication = $self->implies($dep);
|
| + unless (defined($implication) && $implication == 1) {
|
| + $res = $implication;
|
| + last if defined $res;
|
| + }
|
| + }
|
| + return $res;
|
| + } elsif ($o->isa('Dpkg::Deps::OR')) {
|
| + # TRUE: Need to imply at least one individual element
|
| + # FALSE: Need to not apply all individual elements
|
| + # UNDEF: The rest
|
| + my $res = undef;
|
| + foreach my $dep ($o->get_deps()) {
|
| + my $implication = $self->implies($dep);
|
| + if (defined($implication)) {
|
| + if (not defined $res) {
|
| + $res = $implication;
|
| + } else {
|
| + if ($implication) {
|
| + $res = 1;
|
| + } else {
|
| + $res = 0;
|
| + }
|
| + }
|
| + last if defined($res) && $res == 1;
|
| + }
|
| + }
|
| + return $res;
|
| + } else {
|
| + croak 'Dpkg::Deps::Simple cannot evaluate implication with a ' .
|
| + ref($o);
|
| + }
|
| +}
|
| +
|
| +sub get_deps {
|
| + my $self = shift;
|
| + return $self;
|
| +}
|
| +
|
| +sub sort {
|
| + # Nothing to sort
|
| +}
|
| +
|
| +sub arch_is_concerned {
|
| + my ($self, $host_arch) = @_;
|
| +
|
| + return 0 if not defined $self->{package}; # Empty dep
|
| + return 1 if not defined $self->{arches}; # Dep without arch spec
|
| +
|
| + my $seen_arch = 0;
|
| + foreach my $arch (@{$self->{arches}}) {
|
| + $arch=lc($arch);
|
| +
|
| + if ($arch =~ /^!/) {
|
| + my $not_arch = $arch;
|
| + $not_arch =~ s/^!//;
|
| +
|
| + if (debarch_is($host_arch, $not_arch)) {
|
| + $seen_arch = 0;
|
| + last;
|
| + } else {
|
| + # !arch includes by default all other arches
|
| + # unless they also appear in a !otherarch
|
| + $seen_arch = 1;
|
| + }
|
| + } elsif (debarch_is($host_arch, $arch)) {
|
| + $seen_arch = 1;
|
| + last;
|
| + }
|
| + }
|
| + return $seen_arch;
|
| +}
|
| +
|
| +sub reduce_arch {
|
| + my ($self, $host_arch) = @_;
|
| + if (not $self->arch_is_concerned($host_arch)) {
|
| + $self->reset();
|
| + } else {
|
| + $self->{arches} = undef;
|
| + }
|
| +}
|
| +
|
| +sub has_arch_restriction {
|
| + my ($self) = @_;
|
| + if (defined $self->{arches}) {
|
| + return $self->{package};
|
| + } else {
|
| + return ();
|
| + }
|
| +}
|
| +
|
| +sub profile_is_concerned {
|
| + my ($self, $build_profiles) = @_;
|
| +
|
| + return 0 if not defined $self->{package}; # Empty dep
|
| + return 1 if not defined $self->{restrictions}; # Dep without restrictions
|
| +
|
| + my $seen_profile = 0;
|
| + foreach my $restriction (@{$self->{restrictions}}) {
|
| + # Determine if this restriction is negated, and within the "profile"
|
| + # namespace, otherwise it does not concern this check.
|
| + next if $restriction !~ m/^(!)?profile\.(.*)/;
|
| +
|
| + my $negated = defined $1 && $1 eq '!';
|
| + my $profile = $2;
|
| +
|
| + # Determine if the restriction matches any of the specified profiles.
|
| + my $found = any { $_ eq $profile } @{$build_profiles};
|
| +
|
| + if ($negated) {
|
| + if ($found) {
|
| + $seen_profile = 0;
|
| + last;
|
| + } else {
|
| + # "!profile.this" includes by default all other profiles
|
| + # unless they also appear in a "!profile.other".
|
| + $seen_profile = 1;
|
| + }
|
| + } elsif ($found) {
|
| + $seen_profile = 1;
|
| + last;
|
| + }
|
| + }
|
| + return $seen_profile;
|
| +}
|
| +
|
| +sub reduce_profiles {
|
| + my ($self, $build_profiles) = @_;
|
| +
|
| + if (not $self->profile_is_concerned($build_profiles)) {
|
| + $self->reset();
|
| + } else {
|
| + $self->{restrictions} = undef;
|
| + }
|
| +}
|
| +
|
| +sub get_evaluation {
|
| + my ($self, $facts) = @_;
|
| + return if not defined $self->{package};
|
| + return $facts->_evaluate_simple_dep($self);
|
| +}
|
| +
|
| +sub simplify_deps {
|
| + my ($self, $facts) = @_;
|
| + my $eval = $self->get_evaluation($facts);
|
| + $self->reset() if defined $eval and $eval == 1;
|
| +}
|
| +
|
| +sub is_empty {
|
| + my $self = shift;
|
| + return not defined $self->{package};
|
| +}
|
| +
|
| +sub merge_union {
|
| + my ($self, $o) = @_;
|
| + return 0 if not $o->isa('Dpkg::Deps::Simple');
|
| + return 0 if $self->is_empty() or $o->is_empty();
|
| + return 0 if $self->{package} ne $o->{package};
|
| + return 0 if defined $self->{arches} or defined $o->{arches};
|
| +
|
| + if (not defined $o->{relation} and defined $self->{relation}) {
|
| + # Union is the non-versioned dependency
|
| + $self->{relation} = undef;
|
| + $self->{version} = undef;
|
| + return 1;
|
| + }
|
| +
|
| + my $implication = $self->implies($o);
|
| + my $rev_implication = $o->implies($self);
|
| + if (defined($implication)) {
|
| + if ($implication) {
|
| + $self->{relation} = $o->{relation};
|
| + $self->{version} = $o->{version};
|
| + return 1;
|
| + } else {
|
| + return 0;
|
| + }
|
| + }
|
| + if (defined($rev_implication)) {
|
| + if ($rev_implication) {
|
| + # Already merged...
|
| + return 1;
|
| + } else {
|
| + return 0;
|
| + }
|
| + }
|
| + return 0;
|
| +}
|
| +
|
| +package Dpkg::Deps::Multiple;
|
| +
|
| +=head2 Dpkg::Deps::Multiple
|
| +
|
| +This is the base class for Dpkg::Deps::{AND,OR,Union}. It implements
|
| +the following methods:
|
| +
|
| +=over 4
|
| +
|
| +=item $mul->add($dep)
|
| +
|
| +Adds a new dependency object at the end of the list.
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +use strict;
|
| +use warnings;
|
| +
|
| +use Carp;
|
| +
|
| +use Dpkg::ErrorHandling;
|
| +
|
| +use parent qw(Dpkg::Interface::Storable);
|
| +
|
| +sub new {
|
| + my $this = shift;
|
| + my $class = ref($this) || $this;
|
| + my $self = { list => [ @_ ] };
|
| + bless $self, $class;
|
| + return $self;
|
| +}
|
| +
|
| +sub reset {
|
| + my ($self) = @_;
|
| + $self->{list} = [];
|
| +}
|
| +
|
| +sub add {
|
| + my $self = shift;
|
| + push @{$self->{list}}, @_;
|
| +}
|
| +
|
| +sub get_deps {
|
| + my $self = shift;
|
| + return grep { not $_->is_empty() } @{$self->{list}};
|
| +}
|
| +
|
| +sub sort {
|
| + my $self = shift;
|
| + my @res = ();
|
| + @res = sort { Dpkg::Deps::deps_compare($a, $b) } @{$self->{list}};
|
| + $self->{list} = [ @res ];
|
| +}
|
| +
|
| +sub arch_is_concerned {
|
| + my ($self, $host_arch) = @_;
|
| + my $res = 0;
|
| + foreach my $dep (@{$self->{list}}) {
|
| + $res = 1 if $dep->arch_is_concerned($host_arch);
|
| + }
|
| + return $res;
|
| +}
|
| +
|
| +sub reduce_arch {
|
| + my ($self, $host_arch) = @_;
|
| + my @new;
|
| + foreach my $dep (@{$self->{list}}) {
|
| + $dep->reduce_arch($host_arch);
|
| + push @new, $dep if $dep->arch_is_concerned($host_arch);
|
| + }
|
| + $self->{list} = [ @new ];
|
| +}
|
| +
|
| +sub has_arch_restriction {
|
| + my ($self) = @_;
|
| + my @res;
|
| + foreach my $dep (@{$self->{list}}) {
|
| + push @res, $dep->has_arch_restriction();
|
| + }
|
| + return @res;
|
| +}
|
| +
|
| +
|
| +sub is_empty {
|
| + my $self = shift;
|
| + return scalar @{$self->{list}} == 0;
|
| +}
|
| +
|
| +sub merge_union {
|
| + croak 'method merge_union() is only valid for Dpkg::Deps::Simple';
|
| +}
|
| +
|
| +package Dpkg::Deps::AND;
|
| +
|
| +=head2 Dpkg::Deps::AND
|
| +
|
| +This object represents a list of dependencies who must be met at the same
|
| +time.
|
| +
|
| +=over 4
|
| +
|
| +=item $and->output([$fh])
|
| +
|
| +The output method uses ", " to join the list of sub-dependencies.
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +use strict;
|
| +use warnings;
|
| +
|
| +use parent -norequire, qw(Dpkg::Deps::Multiple);
|
| +
|
| +sub output {
|
| + my ($self, $fh) = @_;
|
| + my $res = join(', ', map { $_->output() } grep { not $_->is_empty() } $self->get_deps());
|
| + if (defined($fh)) {
|
| + print { $fh } $res;
|
| + }
|
| + return $res;
|
| +}
|
| +
|
| +sub implies {
|
| + my ($self, $o) = @_;
|
| + # If any individual member can imply $o or NOT $o, we're fine
|
| + foreach my $dep ($self->get_deps()) {
|
| + my $implication = $dep->implies($o);
|
| + return 1 if defined($implication) && $implication == 1;
|
| + return 0 if defined($implication) && $implication == 0;
|
| + }
|
| + # If o is an AND, we might have an implication, if we find an
|
| + # implication within us for each predicate in o
|
| + if ($o->isa('Dpkg::Deps::AND')) {
|
| + my $subset = 1;
|
| + foreach my $odep ($o->get_deps()) {
|
| + my $found = 0;
|
| + foreach my $dep ($self->get_deps()) {
|
| + $found = 1 if $dep->implies($odep);
|
| + }
|
| + $subset = 0 if not $found;
|
| + }
|
| + return 1 if $subset;
|
| + }
|
| + return;
|
| +}
|
| +
|
| +sub get_evaluation {
|
| + my ($self, $facts) = @_;
|
| + # Return 1 only if all members evaluates to true
|
| + # Return 0 if at least one member evaluates to false
|
| + # Return undef otherwise
|
| + my $result = 1;
|
| + foreach my $dep ($self->get_deps()) {
|
| + my $eval = $dep->get_evaluation($facts);
|
| + if (not defined $eval) {
|
| + $result = undef;
|
| + } elsif ($eval == 0) {
|
| + $result = 0;
|
| + last;
|
| + } elsif ($eval == 1) {
|
| + # Still possible
|
| + }
|
| + }
|
| + return $result;
|
| +}
|
| +
|
| +sub simplify_deps {
|
| + my ($self, $facts, @knowndeps) = @_;
|
| + my @new;
|
| +
|
| +WHILELOOP:
|
| + while (@{$self->{list}}) {
|
| + my $dep = shift @{$self->{list}};
|
| + my $eval = $dep->get_evaluation($facts);
|
| + next if defined($eval) and $eval == 1;
|
| + foreach my $odep (@knowndeps, @new) {
|
| + next WHILELOOP if $odep->implies($dep);
|
| + }
|
| + # When a dependency is implied by another dependency that
|
| + # follows, then invert them
|
| + # "a | b, c, a" becomes "a, c" and not "c, a"
|
| + my $i = 0;
|
| + foreach my $odep (@{$self->{list}}) {
|
| + if (defined $odep and $odep->implies($dep)) {
|
| + splice @{$self->{list}}, $i, 1;
|
| + unshift @{$self->{list}}, $odep;
|
| + next WHILELOOP;
|
| + }
|
| + $i++;
|
| + }
|
| + push @new, $dep;
|
| + }
|
| + $self->{list} = [ @new ];
|
| +}
|
| +
|
| +
|
| +package Dpkg::Deps::OR;
|
| +
|
| +=head2 Dpkg::Deps::OR
|
| +
|
| +This object represents a list of dependencies of which only one must be met
|
| +for the dependency to be true.
|
| +
|
| +=over 4
|
| +
|
| +=item $or->output([$fh])
|
| +
|
| +The output method uses " | " to join the list of sub-dependencies.
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +use strict;
|
| +use warnings;
|
| +
|
| +use parent -norequire, qw(Dpkg::Deps::Multiple);
|
| +
|
| +sub output {
|
| + my ($self, $fh) = @_;
|
| + my $res = join(' | ', map { $_->output() } grep { not $_->is_empty() } $self->get_deps());
|
| + if (defined($fh)) {
|
| + print { $fh } $res;
|
| + }
|
| + return $res;
|
| +}
|
| +
|
| +sub implies {
|
| + my ($self, $o) = @_;
|
| +
|
| + # Special case for AND with a single member, replace it by its member
|
| + if ($o->isa('Dpkg::Deps::AND')) {
|
| + my @subdeps = $o->get_deps();
|
| + if (scalar(@subdeps) == 1) {
|
| + $o = $subdeps[0];
|
| + }
|
| + }
|
| +
|
| + # In general, an OR dependency can't imply anything except if each
|
| + # of its member implies a member in the other OR dependency
|
| + if ($o->isa('Dpkg::Deps::OR')) {
|
| + my $subset = 1;
|
| + foreach my $dep ($self->get_deps()) {
|
| + my $found = 0;
|
| + foreach my $odep ($o->get_deps()) {
|
| + $found = 1 if $dep->implies($odep);
|
| + }
|
| + $subset = 0 if not $found;
|
| + }
|
| + return 1 if $subset;
|
| + }
|
| + return;
|
| +}
|
| +
|
| +sub get_evaluation {
|
| + my ($self, $facts) = @_;
|
| + # Returns false if all members evaluates to 0
|
| + # Returns true if at least one member evaluates to true
|
| + # Returns undef otherwise
|
| + my $result = 0;
|
| + foreach my $dep ($self->get_deps()) {
|
| + my $eval = $dep->get_evaluation($facts);
|
| + if (not defined $eval) {
|
| + $result = undef;
|
| + } elsif ($eval == 1) {
|
| + $result = 1;
|
| + last;
|
| + } elsif ($eval == 0) {
|
| + # Still possible to have a false evaluation
|
| + }
|
| + }
|
| + return $result;
|
| +}
|
| +
|
| +sub simplify_deps {
|
| + my ($self, $facts) = @_;
|
| + my @new;
|
| +
|
| +WHILELOOP:
|
| + while (@{$self->{list}}) {
|
| + my $dep = shift @{$self->{list}};
|
| + my $eval = $dep->get_evaluation($facts);
|
| + if (defined($eval) and $eval == 1) {
|
| + $self->{list} = [];
|
| + return;
|
| + }
|
| + foreach my $odep (@new, @{$self->{list}}) {
|
| + next WHILELOOP if $odep->implies($dep);
|
| + }
|
| + push @new, $dep;
|
| + }
|
| + $self->{list} = [ @new ];
|
| +}
|
| +
|
| +package Dpkg::Deps::Union;
|
| +
|
| +=head2 Dpkg::Deps::Union
|
| +
|
| +This object represents a list of relationships.
|
| +
|
| +=over 4
|
| +
|
| +=item $union->output([$fh])
|
| +
|
| +The output method uses ", " to join the list of relationships.
|
| +
|
| +=item $union->implies($other_dep)
|
| +
|
| +=item $union->get_evaluation($other_dep)
|
| +
|
| +Those methods are not meaningful for this object and always return undef.
|
| +
|
| +=item $union->simplify_deps($facts)
|
| +
|
| +The simplication is done to generate an union of all the relationships.
|
| +It uses $simple_dep->merge_union($other_dep) to get its job done.
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +use strict;
|
| +use warnings;
|
| +
|
| +use parent -norequire, qw(Dpkg::Deps::Multiple);
|
| +
|
| +sub output {
|
| + my ($self, $fh) = @_;
|
| + my $res = join(', ', map { $_->output() } grep { not $_->is_empty() } $self->get_deps());
|
| + if (defined($fh)) {
|
| + print { $fh } $res;
|
| + }
|
| + return $res;
|
| +}
|
| +
|
| +sub implies {
|
| + # Implication test are not useful on Union
|
| + return;
|
| +}
|
| +
|
| +sub get_evaluation {
|
| + # Evaluation are not useful on Union
|
| + return;
|
| +}
|
| +
|
| +sub simplify_deps {
|
| + my ($self, $facts) = @_;
|
| + my @new;
|
| +
|
| +WHILELOOP:
|
| + while (@{$self->{list}}) {
|
| + my $odep = shift @{$self->{list}};
|
| + foreach my $dep (@new) {
|
| + next WHILELOOP if $dep->merge_union($odep);
|
| + }
|
| + push @new, $odep;
|
| + }
|
| + $self->{list} = [ @new ];
|
| +}
|
| +
|
| +package Dpkg::Deps::KnownFacts;
|
| +
|
| +=head2 Dpkg::Deps::KnownFacts
|
| +
|
| +This object represents a list of installed packages and a list of virtual
|
| +packages provided (by the set of installed packages).
|
| +
|
| +=over 4
|
| +
|
| +=item my $facts = Dpkg::Deps::KnownFacts->new();
|
| +
|
| +Creates a new object.
|
| +
|
| +=cut
|
| +
|
| +use strict;
|
| +use warnings;
|
| +
|
| +use Dpkg::Version;
|
| +
|
| +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. This might be used in the future for versioned provides.
|
| +
|
| +=cut
|
| +
|
| +sub add_provided_package {
|
| + my ($self, $pkg, $rel, $ver, $by) = @_;
|
| + if (not exists $self->{virtualpkg}{$pkg}) {
|
| + $self->{virtualpkg}{$pkg} = [];
|
| + }
|
| + push @{$self->{virtualpkg}{$pkg}}, [ $by, $rel, $ver ];
|
| +}
|
| +
|
| +=item my ($check, $param) = $facts->check_package($package)
|
| +
|
| +$check is one when the package is found. For a real package, $param
|
| +contains the version. For a virtual package, $param contains an array
|
| +reference containing the list of packages that provide it (each package is
|
| +listed as [ $provider, $relation, $version ]).
|
| +
|
| +This function is obsolete and should not be used. Dpkg::Deps::KnownFacts
|
| +is only meant to be filled with data and then passed to Dpkg::Deps
|
| +methods where appropriate, but it should not be directly queried.
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +sub check_package {
|
| + my ($self, $pkg) = @_;
|
| + if (exists $self->{pkg}{$pkg}) {
|
| + return (1, $self->{pkg}{$pkg}[0]{version});
|
| + }
|
| + if (exists $self->{virtualpkg}{$pkg}) {
|
| + return (1, $self->{virtualpkg}{$pkg});
|
| + }
|
| + return (0, undef);
|
| +}
|
| +
|
| +## The functions below are private to Dpkg::Deps
|
| +
|
| +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};
|
| + my $build_arch = $dep->{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 $p if $a eq $build_arch and $ma ne 'foreign';
|
| + } 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}};
|
| +}
|
| +
|
| +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)) {
|
| + # XXX: Adapt when versioned provides are allowed
|
| + next if defined $virtpkg->[1];
|
| + next if defined $dep->{relation}; # Provides don't satisfy versioned deps
|
| + return 1;
|
| + }
|
| + return if $lackinfos;
|
| + return 0;
|
| +}
|
| +
|
| +=head1 CHANGES
|
| +
|
| +=head2 Version 1.02
|
| +
|
| +=over
|
| +
|
| +=item * Add new Dpkg::deps_concat() function.
|
| +
|
| +=back
|
| +
|
| +=head2 Version 1.01
|
| +
|
| +=over
|
| +
|
| +=item * Add new $dep->reset() method that all dependency objects support.
|
| +
|
| +=item * Dpkg::Deps::Simple now recognizes the arch qualifier "any" and
|
| +stores it in the "archqual" property when present.
|
| +
|
| +=item * Dpkg::Deps::KnownFacts->add_installed_package() now accepts 2
|
| +supplementary parameters ($arch and $multiarch).
|
| +
|
| +=item * Dpkg::Deps::KnownFacts->check_package() is obsolete, it should
|
| +not have been part of the public API.
|
| +
|
| +=back
|
| +
|
| +=cut
|
| +
|
| +1;
|
|
|