File: | Dpkg/Deps/KnownFacts.pm |
Coverage: | 83.3% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
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 | package Dpkg::Deps::KnownFacts; | ||||||
23 | |||||||
24 | =encoding utf8 | ||||||
25 | |||||||
26 - 35 | =head1 NAME Dpkg::Deps::KnownFacts - list of installed real and virtual packages =head1 DESCRIPTION This class represents a list of installed packages and a list of virtual packages provided (by the set of installed packages). =cut | ||||||
36 | |||||||
37 | 1 1 1 | 2 1 11 | use strict; | ||||
38 | 1 1 1 | 2 0 21 | use warnings; | ||||
39 | |||||||
40 | our $VERSION = '2.00'; | ||||||
41 | |||||||
42 | 1 1 1 | 1 1 321 | use Dpkg::Version; | ||||
43 | |||||||
44 - 52 | =head1 METHODS =over 4 =item $facts = Dpkg::Deps::KnownFacts->new(); Creates a new object. =cut | ||||||
53 | |||||||
54 | sub new { | ||||||
55 | 1 | 1 | 1 | my $this = shift; | |||
56 | 1 | 3 | my $class = ref($this) || $this; | ||||
57 | 1 | 2 | my $self = { | ||||
58 | pkg => {}, | ||||||
59 | virtualpkg => {}, | ||||||
60 | }; | ||||||
61 | |||||||
62 | 1 | 1 | bless $self, $class; | ||||
63 | 1 | 1 | return $self; | ||||
64 | } | ||||||
65 | |||||||
66 - 76 | =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 | ||||||
77 | |||||||
78 | sub add_installed_package { | ||||||
79 | 9 | 1 | 7 | my ($self, $pkg, $ver, $arch, $multiarch) = @_; | |||
80 | 9 | 15 | my $p = { | ||||
81 | package => $pkg, | ||||||
82 | version => $ver, | ||||||
83 | architecture => $arch, | ||||||
84 | multiarch => $multiarch // 'no', | ||||||
85 | }; | ||||||
86 | |||||||
87 | 9 | 11 | $self->{pkg}{"$pkg:$arch"} = $p if defined $arch; | ||||
88 | 9 9 | 5 8 | push @{$self->{pkg}{$pkg}}, $p; | ||||
89 | } | ||||||
90 | |||||||
91 - 97 | =item $facts->add_provided_package($virtual, $relation, $version, $by) Records that the "$by" package provides the $virtual package. $relation and $version correspond to the associated relation given in the Provides field (if present). =cut | ||||||
98 | |||||||
99 | sub add_provided_package { | ||||||
100 | 3 | 1 | 3 | my ($self, $pkg, $rel, $ver, $by) = @_; | |||
101 | 3 | 3 | my $v = { | ||||
102 | package => $pkg, | ||||||
103 | relation => $rel, | ||||||
104 | version => $ver, | ||||||
105 | provider => $by, | ||||||
106 | }; | ||||||
107 | |||||||
108 | 3 | 6 | $self->{virtualpkg}{$pkg} //= []; | ||||
109 | 3 3 | 2 2 | push @{$self->{virtualpkg}{$pkg}}, $v; | ||||
110 | } | ||||||
111 | |||||||
112 | ## | ||||||
113 | ## The functions below are private to Dpkg::Deps::KnownFacts. | ||||||
114 | ## | ||||||
115 | |||||||
116 | sub _find_package { | ||||||
117 | 56 | 32 | my ($self, $dep, $lackinfos) = @_; | ||||
118 | 56 | 46 | my ($pkg, $archqual) = ($dep->{package}, $dep->{archqual}); | ||||
119 | |||||||
120 | 56 | 54 | return if not exists $self->{pkg}{$pkg}; | ||||
121 | |||||||
122 | 11 | 19 | my $host_arch = $dep->{host_arch} // Dpkg::Arch::get_host_arch(); | ||||
123 | 11 | 13 | my $build_arch = $dep->{build_arch} // Dpkg::Arch::get_build_arch(); | ||||
124 | |||||||
125 | 11 11 | 4 13 | foreach my $p (@{$self->{pkg}{$pkg}}) { | ||||
126 | 11 | 6 | my $a = $p->{architecture}; | ||||
127 | 11 | 9 | my $ma = $p->{multiarch}; | ||||
128 | |||||||
129 | 11 | 5 | if (not defined $a) { | ||||
130 | 0 | 0 | $$lackinfos = 1; | ||||
131 | 0 | 0 | next; | ||||
132 | } | ||||||
133 | 11 | 11 | if (not defined $archqual) { | ||||
134 | 8 | 8 | return $p if $ma eq 'foreign'; | ||||
135 | 5 | 11 | return $p if $a eq $host_arch or $a eq 'all'; | ||||
136 | } elsif ($archqual eq 'any') { | ||||||
137 | 1 | 2 | return $p if $ma eq 'allowed'; | ||||
138 | } elsif ($archqual eq 'native') { | ||||||
139 | 2 | 4 | return if $ma eq 'foreign'; | ||||
140 | 1 | 3 | return $p if $a eq $build_arch or $a eq 'all'; | ||||
141 | } else { | ||||||
142 | 0 | 0 | return $p if $a eq $archqual; | ||||
143 | } | ||||||
144 | } | ||||||
145 | 2 | 2 | return; | ||||
146 | } | ||||||
147 | |||||||
148 | sub _find_virtual_packages { | ||||||
149 | 48 | 30 | my ($self, $pkg) = @_; | ||||
150 | |||||||
151 | 48 | 45 | return () if not exists $self->{virtualpkg}{$pkg}; | ||||
152 | 6 6 | 4 6 | return @{$self->{virtualpkg}{$pkg}}; | ||||
153 | } | ||||||
154 | |||||||
155 - 159 | =item $facts->evaluate_simple_dep() This method is private and should not be used except from within Dpkg::Deps. =cut | ||||||
160 | |||||||
161 | sub evaluate_simple_dep { | ||||||
162 | 56 | 1 | 34 | my ($self, $dep) = @_; | |||
163 | 56 | 47 | my ($lackinfos, $pkg) = (0, $dep->{package}); | ||||
164 | |||||||
165 | 56 | 56 | my $p = $self->_find_package($dep, \$lackinfos); | ||||
166 | 56 | 37 | if ($p) { | ||||
167 | 8 | 7 | if (defined $dep->{relation}) { | ||||
168 | 1 | 0 | if (defined $p->{version}) { | ||||
169 | return 1 if version_compare_relation($p->{version}, | ||||||
170 | $dep->{relation}, | ||||||
171 | 1 | 2 | $dep->{version}); | ||||
172 | } else { | ||||||
173 | 0 | 0 | $lackinfos = 1; | ||||
174 | } | ||||||
175 | } else { | ||||||
176 | 7 | 5 | return 1; | ||||
177 | } | ||||||
178 | } | ||||||
179 | 48 | 29 | foreach my $virtpkg ($self->_find_virtual_packages($pkg)) { | ||||
180 | next if defined $virtpkg->{relation} and | ||||||
181 | 6 | 9 | $virtpkg->{relation} ne REL_EQ; | ||||
182 | |||||||
183 | 5 | 3 | if (defined $dep->{relation}) { | ||||
184 | 3 | 4 | next if not defined $virtpkg->{version}; | ||||
185 | return 1 if version_compare_relation($virtpkg->{version}, | ||||||
186 | $dep->{relation}, | ||||||
187 | 2 | 3 | $dep->{version}); | ||||
188 | } else { | ||||||
189 | 2 | 2 | return 1; | ||||
190 | } | ||||||
191 | } | ||||||
192 | 45 | 30 | return if $lackinfos; | ||||
193 | 45 | 32 | return 0; | ||||
194 | } | ||||||
195 | |||||||
196 | =back | ||||||
197 | |||||||
198 - 216 | =head1 CHANGES =head2 Version 2.00 (dpkg 1.20.0) Remove method: $facts->check_package(). =head2 Version 1.01 (dpkg 1.16.1) New option: Dpkg::Deps::KnownFacts->add_installed_package() now accepts 2 supplementary parameters ($arch and $multiarch). Deprecated method: Dpkg::Deps::KnownFacts->check_package() is obsolete, it should not have been part of the public API. =head2 Version 1.00 (dpkg 1.15.6) Mark the module as public. =cut | ||||||
217 | |||||||
218 | 1; |