1 package Debbugs::Versions;
7 Debbugs::Versions - debbugs version information processing
11 The Debbugs::Versions module provides generic support functions for the
12 implementation of version tracking in debbugs.
14 Complex organizations, such as Debian, require the tracking of bugs in
15 multiple versions of packages. The versioning scheme is frequently branched:
16 for example, a security update announced by an upstream developer will be
17 packaged as-is for the unstable distribution while a minimal backport is
18 made to the stable distribution. In order to report properly on the bugs
19 open in each distribution, debbugs must be aware of the structure of the
20 version tree for each package.
22 Gathering the version data is beyond the scope of this module: in the case
23 of Debian it is carried out by mechanical analysis of package changelogs.
24 Debbugs::Versions takes version data for a package generated by this or any
25 other means, merges it into a tree structure, and allows the user to perform
26 queries based on supplied data about the versions in which bugs have been
27 found and the versions in which they have been fixed.
31 The data format looks like this (backslashes are not actually there, and
32 indicate continuation lines):
34 1.5.4 1.5.0 1.5-iwj.0.4 1.5-iwj.0.3 1.5-iwj.0.2 1.5-iwj.0.1 1.4.0 1.3.14 \
35 1.3.13 1.3.12 1.3.11 1.3.10 ...
36 1.4.1.6 1.4.1.5 1.4.1.4 1.4.1.3 1.4.1.2 1.4.1.1 1.4.1 1.4.0.31 1.4.0.30 \
37 1.4.0.29 1.4.0.28 1.4.0.27 1.4.0.26.0.1 1.4.0.26 1.4.0.25 1.4.0.24 \
38 1.4.0.23.2 1.4.0.23.1 1.4.0.23 1.4.0.22 1.4.0.21 1.4.0.20 1.4.0.19 \
39 1.4.0.18 1.4.0.17 1.4.0.16 1.4.0.15 1.4.0.14 1.4.0.13 1.4.0.12 \
40 1.4.0.11 1.4.0.10 1.4.0.9 1.4.0.8 1.4.0.7 1.4.0.6 1.4.0.5 1.4.0.4 \
41 1.4.0.3 1.4.0.2 1.4.0.1 1.4.0 \
42 1.4.0.35 1.4.0.34 1.4.0.33 1.4.0.32 1.4.0.31
50 Constructs a Debbugs::Versions object. The argument is a reference to a
51 version comparison function, which must be usable by Perl's built-in C<sort>
59 my $class = ref($this) || $this;
61 my $self = { parent => {}, vercmp => $vercmp };
62 return bless $self, $class;
67 Takes two arguments, C<ancestor> and C<descendant>. Returns true if and only
68 if C<ancestor> is a version on which C<descendant> is based according to the
69 version data supplied to this object. (As a degenerate case, this relation
70 is reflexive: a version is considered to be an ancestor of itself.)
72 This method is expected mainly to be used internally by the C<merge> method.
80 my $descendant = shift;
82 my $parent = $self->{parent};
83 for (my $node = $descendant; defined $node; $node = $parent->{$node}) {
84 return 1 if $node eq $ancestor;
92 Find the leaves of the version tree, i.e. those versions with no
95 This method is mainly for internal use.
103 my $parent = $self->{parent};
104 my @vers = keys %$parent;
106 @leaf{@vers} = (1) x @vers;
108 delete $leaf{$parent->{$v}} if defined $parent->{$v};
115 Merges one branch of version data into this object. This branch takes the
116 form of a list of versions, each of which is to be considered as based on
117 the next in the list.
126 for my $i (1 .. $#_) {
128 next if $self->isancestor($last, $_[$i]);
130 # If it's already an ancestor version, don't add it again. This
131 # keeps the tree correct when we get several partial branches, such
132 # as '1.4.0 1.3.14 1.3.13 1.3.12' followed by '1.4.0 1.3.12 1.3.10'.
133 unless ($self->isancestor($_[$i], $last)) {
134 $self->{parent}{$last} = $_[$i];
139 # Insert undef for the last version so that we can tell a known version
140 # by seeing if it exists in $self->{parent}.
141 $self->{parent}{$_[$#_]} = undef unless exists $self->{parent}{$_[$#_]};
146 Loads version data from the filehandle passed as the argument. Each line of
147 input is expected to represent one branch, with versions separated by
164 Outputs the version tree represented by this object to the filehandle passed
165 as the argument. The format is the same as that expected by the C<load>
175 my $parent = $self->{parent};
177 # TODO: breaks with tcp-wrappers/1.0-1 tcpd/2.0-1 case
178 my @leaves = reverse sort {
179 my ($x, $y) = ($a, $b);
182 $self->{vercmp}->($x, $y);
186 for my $lf (@leaves) {
189 for (my $node = $parent->{$lf}; defined $node;
190 $node = $parent->{$node}) {
192 last if exists $seen{$node};
201 Takes three arguments, C<version>, C<found>, and C<fixed>. Returns true if
202 and only if C<version> is based on or equal to a version in the list
203 referenced by C<found>, and not based on or equal to one referenced by
206 C<buggy> attempts to cope with found and fixed versions not in the version
207 tree by simply checking whether any fixed versions are recorded in the event
208 that nothing is known about any of the found versions.
219 my %found = map { $_ => 1 } @$found;
220 my %fixed = map { $_ => 1 } @$fixed;
221 my $parent = $self->{parent};
222 for (my $node = $version; defined $node; $node = $parent->{$node}) {
223 # The found and fixed tests are this way round because the most
224 # likely scenario is that somebody thought they'd fixed a bug and
225 # then it was reopened because it turned out not to have been fixed
226 # after all. However, tools that build found and fixed lists should
227 # generally know the order of events and make sure that the two
228 # lists have no common entries.
229 return 'found' if $found{$node};
230 return 'fixed' if $fixed{$node};
234 # We don't know when it was found. Was it fixed in a descendant of
235 # this version? If so, this one should be considered buggy.
236 for my $f (@$fixed) {
237 for (my $node = $f; defined $node; $node = $parent->{$node}) {
238 return 'found' if $node eq $version;
243 # Nothing in the requested version's ancestor chain can be confirmed as
244 # a version in which the bug was found or fixed. If it was only found or
245 # fixed on some other branch, then this one isn't buggy.
246 for my $f (@$found, @$fixed) {
247 return 'absent' if exists $parent->{$f};
250 # Otherwise, we degenerate to checking whether any fixed versions at all
252 return 'fixed' if @$fixed;
258 Takes two arguments, C<found> and C<fixed>, which are interpreted as in
259 L</buggy>. Efficiently returns the state of the bug at every known version,
260 in the form of a hash from versions to states (as returned by L</buggy>). If
261 you pass a third argument, C<interested>, this method will stop after
262 determining the state of the bug at all the versions listed therein.
264 Whether this is faster than calling L</buggy> for each version you're
265 interested in is not altogether clear, and depends rather strongly on the
266 number of known and interested versions.
270 sub allstates ($$$;$)
275 my $interested = shift;
277 my %found = map { $_ => 1 } @$found;
278 my %fixed = map { $_ => 1 } @$fixed;
280 if (defined $interested) {
281 %interested = map { $_ => 1 } @$interested;
283 my $parent = $self->{parent};
284 my @leaves = $self->leaves();
286 # Are any of the found or fixed versions known? We'll need this later.
288 for my $f (@$found, @$fixed) {
289 if (exists $parent->{$f}) {
295 # Start at each leaf in turn, working our way up and remembering the
296 # list of versions in the branch.
298 LEAF: for my $lf (@leaves) {
302 for (my $node = $lf; defined $node; $node = $parent->{$node}) {
303 # If we're about to start a new branch, check whether we know
304 # the state of every version in which we're interested. If so,
306 if (defined $interested and not @branch) {
308 for my $interest (keys %interested) {
309 if (exists $state{$interest}) {
310 push @remove, $interest;
313 delete @interested{@remove};
314 last LEAF unless keys %interested;
317 # We encounter a version whose state we already know. Record the
318 # branch with the same state as that version, and go on to the
320 if (exists $state{$node}) {
321 $state{$_} = $state{$node} foreach @branch;
327 # We encounter a version in the found list. Record the branch as
328 # 'found', and start a new branch.
330 $state{$_} = 'found' foreach @branch;
334 # We encounter a version in the fixed list. Record the branch as
335 # 'fixed', and start a new branch, remembering that we have a
337 elsif ($fixed{$node}) {
338 $state{$_} = 'fixed' foreach @branch;
343 # We encounter a root.
344 elsif (not defined $parent->{$node}) {
345 # If the found list is empty and we have a fixed descendant,
346 # record the branch as 'found' (since they probably just
347 # forgot to report a version when opening the bug).
348 if (not @$found and $fixeddesc) {
349 $state{$_} = 'found' foreach @branch;
352 # If any of the found or fixed versions are known, record
353 # the branch as 'absent' (since all the activity must have
354 # happened on some other branch).
356 $state{$_} = 'absent' foreach @branch;
359 # If there are any fixed versions at all (but they're
360 # unknown), then who knows, but we guess at recording the
363 $state{$_} = 'fixed' foreach @branch;
366 # Otherwise, fall back to recording the branch as 'found'.
368 $state{$_} = 'found' foreach @branch;
371 # In any case, we're done.