| Current File : //proc/self/root/usr/share/perl5/Dpkg/Deps/Simple.pm |
# 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::Simple - represents a single dependency statement
=head1 DESCRIPTION
This class represents a single dependency statement.
It has several 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 is
undefined when there's no restriction, otherwise it is 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 is none).
In the dependency "python:any (>= 2.6)", the arch qualifier is "any".
=item restrictions
The restrictions formula for this dependency. It is undefined when there
is no restriction formula. Otherwise it is an array ref.
=back
=cut
package Dpkg::Deps::Simple 1.02;
use strict;
use warnings;
use Carp;
use Dpkg::Arch qw(debarch_is_concerned debarch_list_parse);
use Dpkg::BuildProfiles qw(parse_build_profiles evaluate_restriction_formula);
use Dpkg::Version;
use Dpkg::ErrorHandling;
use Dpkg::Gettext;
use parent qw(Dpkg::Interface::Storable);
=head1 METHODS
=over 4
=item $dep = Dpkg::Deps::Simple->new([$dep[, %opts]]);
Creates a new object. Some options can be set through %opts:
=over
=item host_arch
Sets the host architecture.
=item build_arch
Sets the build architecture.
=item build_dep
Specifies whether the parser should consider it a build dependency.
Defaults to 0.
=item tests_dep
Specifies whether the parser should consider it a tests dependency.
Defaults to 0.
This option implicitly (and forcibly) enables C<build_dep> because test
dependencies are based on build dependencies (since dpkg 1.22.1).
=back
=cut
sub new {
my ($this, $arg, %opts) = @_;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
$self->reset();
$self->{host_arch} = $opts{host_arch};
$self->{build_arch} = $opts{build_arch};
$self->{build_dep} = $opts{build_dep} // 0;
$self->{tests_dep} = $opts{tests_dep} // 0;
if ($self->{tests_dep}) {
$self->{build_dep} = 1;
}
$self->parse_string($arg) if defined $arg;
return $self;
}
=item $dep->reset()
Clears any dependency information stored in $dep so that $dep->is_empty()
returns true.
=cut
sub reset {
my $self = shift;
$self->{package} = undef;
$self->{relation} = undef;
$self->{version} = undef;
$self->{arches} = undef;
$self->{archqual} = undef;
$self->{restrictions} = undef;
}
=item $dep->parse_string($dep_string)
Parses the dependency string and modifies internal properties to match the
parsed dependency.
=cut
sub parse_string {
my ($self, $dep) = @_;
my $pkgname_re;
if ($self->{tests_dep}) {
$pkgname_re = qr/[\@a-zA-Z0-9][\@a-zA-Z0-9+.-]*/;
} else {
$pkgname_re = qr/[a-zA-Z0-9][a-zA-Z0-9+.-]*/;
}
## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
return if not $dep =~
m{^\s* # skip leading whitespace
($pkgname_re) # 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* ([^\)\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* [^>]+ # do not 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} = [ debarch_list_parse($5) ];
}
if (defined $6) {
$self->{restrictions} = [ parse_build_profiles($6) ];
}
}
=item $dep->parse($fh, $desc)
Parse a dependency line from a filehandle.
=cut
sub parse {
my ($self, $fh, $desc) = @_;
my $line = <$fh>;
chomp $line;
return $self->parse_string($line);
}
=item $dep->load($filename)
Parse a dependency line from $filename.
=item $dep->output([$fh])
=item "$dep"
Returns a string representing the dependency. If $fh is set, it prints
the string to the filehandle.
=cut
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}) {
for my $restrlist (@{$self->{restrictions}}) {
$res .= ' <' . join(' ', @{$restrlist}) . '>';
}
}
if (defined $fh) {
print { $fh } $res;
}
return $res;
}
=item $dep->save($filename)
Save the dependency into the given $filename.
=cut
# _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 and $p->[0] =~ /^!/;
my $q_arch_neg = defined $q and $q->[0] =~ /^!/;
if (not defined $p) {
# If "p" has no arches, it is a superset of q and we should fall through
# to the version check.
return 1;
} elsif (not defined $q) {
# If q has no arches, it is a superset of p and there are no useful
# implications.
return 0;
} elsif (not $p_arch_neg and not $q_arch_neg) {
# Both have arches. If neither are negated, we know nothing useful
# unless q is a subset of p.
my %p_arches = map { $_ => 1 } @{$p};
my $subset = 1;
for my $arch (@{$q}) {
$subset = 0 unless $p_arches{$arch};
}
return 0 unless $subset;
} elsif ($p_arch_neg and $q_arch_neg) {
# 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).
my %q_arches = map { $_ => 1 } @{$q};
my $subset = 1;
for my $arch (@{$p}) {
$subset = 0 unless $q_arches{$arch};
}
return 0 unless $subset;
} elsif (not $p_arch_neg and $q_arch_neg) {
# 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.
return 0;
} elsif ($p_arch_neg and not $q_arch_neg) {
# 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.
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_implies($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.
#
# Because we are handling dependencies in isolation, and the full context
# of the implications are only known when doing dependency resolution at
# run-time, we can only assert that they are implied if they are equal.
#
# For example dependencies with different arch-qualifiers cannot be simplified
# as these depend on the state of Multi-Arch field in the package depended on.
sub _arch_qualifier_implies {
my ($p, $q) = @_;
return $p eq $q if defined $p and defined $q;
return 1 if not defined $p and not defined $q;
return 0;
}
# _restrictions_imply($p, $q)
#
# Returns true if the restrictions $p and $q are compatible with the
# implication $p -> $q, false otherwise.
# NOTE: We don't try to be very clever here, so we may conservatively
# return false when there is an implication.
sub _restrictions_imply {
my ($p, $q) = @_;
if (not defined $p) {
return 1;
} elsif (not defined $q) {
return 0;
} else {
# Check whether set difference is empty.
my %restr;
for my $restrlist (@{$q}) {
my $reststr = join ' ', sort @{$restrlist};
$restr{$reststr} = 1;
}
for my $restrlist (@{$p}) {
my $reststr = join ' ', sort @{$restrlist};
delete $restr{$reststr};
}
return keys %restr == 0;
}
}
=item $dep->implies($other_dep)
Returns 1 when $dep implies $other_dep. Returns 0 when $dep implies
NOT($other_dep). Returns undef when there is no implication. $dep and
$other_dep do not need to be of the same type.
=cut
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_implies($self->{archqual},
$o->{archqual});
# Our restrictions must imply the restrictions for o
return unless _restrictions_imply($self->{restrictions},
$o->{restrictions});
# 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 and $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;
} elsif ($implication) {
$res = 1;
} else {
$res = 0;
}
last if defined $res and $res == 1;
}
}
return $res;
} else {
croak 'Dpkg::Deps::Simple cannot evaluate implication with a ' .
ref($o);
}
}
=item $dep->get_deps()
Returns a list of sub-dependencies, which for this object it means it
returns itself.
=cut
sub get_deps {
my $self = shift;
return $self;
}
=item $dep->sort()
This method is a no-op for this object.
=cut
sub sort {
# Nothing to sort
}
=item $dep->arch_is_concerned($arch)
Returns true if the dependency applies to the indicated architecture.
=cut
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
return debarch_is_concerned($host_arch, @{$self->{arches}});
}
=item $dep->reduce_arch($arch)
Simplifies the dependency to contain only information relevant to the given
architecture. This object can be left empty after this operation. This trims
off the architecture restriction list of these objects.
=cut
sub reduce_arch {
my ($self, $host_arch) = @_;
if (not $self->arch_is_concerned($host_arch)) {
$self->reset();
} else {
$self->{arches} = undef;
}
}
=item $dep->has_arch_restriction()
Returns the package name if the dependency applies only to a subset of
architectures.
=cut
sub has_arch_restriction {
my $self = shift;
if (defined $self->{arches}) {
return $self->{package};
} else {
return ();
}
}
=item $dep->profile_is_concerned()
Returns true if the dependency applies to the indicated profile.
=cut
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
return evaluate_restriction_formula($self->{restrictions}, $build_profiles);
}
=item $dep->reduce_profiles()
Simplifies the dependency to contain only information relevant to the given
profile. This object can be left empty after this operation. This trims off
the profile restriction list of this object.
=cut
sub reduce_profiles {
my ($self, $build_profiles) = @_;
if (not $self->profile_is_concerned($build_profiles)) {
$self->reset();
} else {
$self->{restrictions} = undef;
}
}
=item $dep->get_evaluation($facts)
Evaluates the dependency given a list of installed packages and a list of
virtual packages provided. These lists are part of the
L<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.
=cut
sub get_evaluation {
my ($self, $facts) = @_;
return if not defined $self->{package};
return $facts->evaluate_simple_dep($self);
}
=item $dep->simplify_deps($facts, @assumed_deps)
Simplifies the dependency as much as possible given the list of facts (see
class L<Dpkg::Deps::KnownFacts>) and a list of other dependencies that are
known to be true.
=cut
sub simplify_deps {
my ($self, $facts) = @_;
my $eval = $self->get_evaluation($facts);
$self->reset() if defined $eval and $eval == 1;
}
=item $dep->is_empty()
Returns true if the dependency is empty and doesn't contain any useful
information. This is true when the object has not yet been initialized.
=cut
sub is_empty {
my $self = shift;
return not defined $self->{package};
}
=item $dep->merge_union($other_dep)
Returns true if $dep could be modified to represent the union of both
dependencies. Otherwise returns false.
=cut
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;
}
=back
=head1 CHANGES
=head2 Version 1.02 (dpkg 1.17.10)
New methods: Add $dep->profile_is_concerned() and $dep->reduce_profiles().
=head2 Version 1.01 (dpkg 1.16.1)
New method: Add $dep->reset().
New property: recognizes the arch qualifier "any" and stores it in the
"archqual" property when present.
=head2 Version 1.00 (dpkg 1.15.6)
Mark the module as public.
=cut
1;