scripts/Dpkg/Deps/OR.pm

   1 # Copyright © 1998 Richard Braakman
   2 # Copyright © 1999 Darren Benham
   3 # Copyright © 2000 Sean 'Shaleh' Perry
   4 # Copyright © 2004 Frank Lichtenheld
   5 # Copyright © 2006 Russ Allbery
   6 # Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
   7 # Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org>
   8 #
   9 # This program is free software; you may redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 2 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  21
  22 =encoding utf8
  23
  24 =head1 NAME
  25
  26 Dpkg::Deps::OR - list of OR dependencies
  27
  28 =head1 DESCRIPTION
  29
  30 This class represents a list of dependencies of which only one must be met
  31 for the dependency to be true. It inherits from L<Dpkg::Deps::Multiple>.
  32
  33 =cut
  34
  35 package Dpkg::Deps::OR 1.00;
  36
  37 use strict;
  38 use warnings;
  39
  40 use parent qw(Dpkg::Deps::Multiple);
  41
  42 =head1 METHODS
  43
  44 =over 4
  45
  46 =item $dep->output([$fh])
  47
  48 The output() method uses " | " to join the list of sub-dependencies.
  49
  50 =cut
  51
  52 sub output {
  53     my ($self, $fh) = @_;
  54
  55     my $res = join(' | ', map {
  56         $_->output()
  57     } grep {
  58         not $_->is_empty()
  59     } $self->get_deps());
  60
  61     if (defined $fh) {
  62         print { $fh } $res;
  63     }
  64     return $res;
  65 }
  66
  67 =item $dep->implies($other_dep)
  68
  69 Returns 1 when $dep implies $other_dep. Returns 0 when $dep implies
  70 NOT($other_dep). Returns undef when there's no implication. $dep and
  71 $other_dep do not need to be of the same type.
  72
  73 =cut
  74
  75 sub implies {
  76     my ($self, $o) = @_;
  77
  78     # Special case for AND with a single member, replace it by its member
  79     if ($o->isa('Dpkg::Deps::AND')) {
  80         my @subdeps = $o->get_deps();
  81         if (scalar(@subdeps) == 1) {
  82             $o = $subdeps[0];
  83         }
  84     }
  85
  86     # In general, an OR dependency can't imply anything except if each
  87     # of its member implies a member in the other OR dependency
  88     if ($o->isa('Dpkg::Deps::OR')) {
  89         my $subset = 1;
  90         foreach my $dep ($self->get_deps()) {
  91             my $found = 0;
  92             foreach my $odep ($o->get_deps()) {
  93                 $found = 1 if $dep->implies($odep);
  94             }
  95             $subset = 0 if not $found;
  96         }
  97         return 1 if $subset;
  98     }
  99     return;
 100 }
 101
 102 =item $dep->get_evaluation($facts)
 103
 104 Evaluates the dependency given a list of installed packages and a list of
 105 virtual packages provided. These lists are part of the
 106 L<Dpkg::Deps::KnownFacts> object given as parameters.
 107
 108 Returns 1 when it's true, 0 when it's false, undef when some information
 109 is lacking to conclude.
 110
 111 =cut
 112
 113 sub get_evaluation {
 114     my ($self, $facts) = @_;
 115
 116     # Returns false if all members evaluates to 0
 117     # Returns true if at least one member evaluates to true
 118     # Returns undef otherwise
 119     my $result = 0;
 120     foreach my $dep ($self->get_deps()) {
 121         my $eval = $dep->get_evaluation($facts);
 122         if (not defined $eval) {
 123             $result = undef;
 124         } elsif ($eval == 1) {
 125             $result = 1;
 126             last;
 127         } elsif ($eval == 0) {
 128             # Still possible to have a false evaluation
 129         }
 130     }
 131     return $result;
 132 }
 133
 134 =item $dep->simplify_deps($facts, @assumed_deps)
 135
 136 Simplifies the dependency as much as possible given the list of facts (see
 137 object L<Dpkg::Deps::KnownFacts>) and a list of other dependencies that are
 138 known to be true.
 139
 140 =cut
 141
 142 sub simplify_deps {
 143     my ($self, $facts) = @_;
 144     my @new;
 145
 146 WHILELOOP:
 147     while (@{$self->{list}}) {
 148         my $dep = shift @{$self->{list}};
 149         my $eval = $dep->get_evaluation($facts);
 150         if (defined $eval and $eval == 1) {
 151             $self->{list} = [];
 152             return;
 153         }
 154         foreach my $odep (@new, @{$self->{list}}) {
 155             next WHILELOOP if $odep->implies($dep);
 156         }
 157         push @new, $dep;
 158     }
 159     $self->{list} = [ @new ];
 160 }
 161
 162 =back
 163
 164 =head1 CHANGES
 165
 166 =head2 Version 1.00 (dpkg 1.15.6)
 167
 168 Mark the module as public.
 169
 170 =cut
 171
 172 1;