Chromium Code Reviews
chromiumcodereview-hr@appspot.gserviceaccount.com (chromiumcodereview-hr) | Please choose your nickname with Settings | Help | Chromium Project | Gerrit Changes | Sign out
(950)

Unified Diff: third_party/dpkg-dev/scripts/Dpkg/Deps.pm

Issue 2425693003: Revert of Linux build: Use sysroot when calculating dependencies (Closed)
Patch Set: Created 4 years, 2 months ago
Use n/p to move between diff chunks; N/P to move between comments. Draft comments are only viewable by you.
Jump to:
View side-by-side diff with in-line comments
Download patch
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
deleted file mode 100644
index 7bc18153c11220f986758c28d38f5206802817d1..0000000000000000000000000000000000000000
--- a/third_party/dpkg-dev/scripts/Dpkg/Deps.pm
+++ /dev/null
@@ -1,1468 +0,0 @@
-# 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;
« no previous file with comments | « third_party/dpkg-dev/scripts/Dpkg/Control/Types.pm ('k') | third_party/dpkg-dev/scripts/Dpkg/ErrorHandling.pm » ('j') | no next file with comments »

Powered by Google App Engine
This is Rietveld 408576698