X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FVersions.pm;fp=Debbugs%2FVersions.pm;h=0000000000000000000000000000000000000000;hb=1e6633a3780f4fd53fc4303852e84d13cdad2dc6;hp=5545b487e3fbcc09790ab5d0facbdda2f020a3aa;hpb=466f7faff129a5699c7674f59900a92aa256175d;p=debbugs.git diff --git a/Debbugs/Versions.pm b/Debbugs/Versions.pm deleted file mode 100644 index 5545b48..0000000 --- a/Debbugs/Versions.pm +++ /dev/null @@ -1,394 +0,0 @@ -# This module is part of debbugs, and is released -# under the terms of the GPL version 2, or any later -# version at your option. -# See the file README and COPYING for more information. -# -# [Other people have contributed to this file; their copyrights should -# go here too.] - -package Debbugs::Versions; - -use warnings; - -use strict; - -=head1 NAME - -Debbugs::Versions - debbugs version information processing - -=head1 DESCRIPTION - -The Debbugs::Versions module provides generic support functions for the -implementation of version tracking in debbugs. - -Complex organizations, such as Debian, require the tracking of bugs in -multiple versions of packages. The versioning scheme is frequently branched: -for example, a security update announced by an upstream developer will be -packaged as-is for the unstable distribution while a minimal backport is -made to the stable distribution. In order to report properly on the bugs -open in each distribution, debbugs must be aware of the structure of the -version tree for each package. - -Gathering the version data is beyond the scope of this module: in the case -of Debian it is carried out by mechanical analysis of package changelogs. -Debbugs::Versions takes version data for a package generated by this or any -other means, merges it into a tree structure, and allows the user to perform -queries based on supplied data about the versions in which bugs have been -found and the versions in which they have been fixed. - -=head1 DATA FORMAT - -The data format looks like this (backslashes are not actually there, and -indicate continuation lines): - - 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 \ - 1.3.13 1.3.12 1.3.11 1.3.10 ... - 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 \ - 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 \ - 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 \ - 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 \ - 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 \ - 1.4.0.3 1.4.0.2 1.4.0.1 1.4.0 \ - 1.4.0.35 1.4.0.34 1.4.0.33 1.4.0.32 1.4.0.31 - -=head1 METHODS - -=over 8 - -=item new - -Constructs a Debbugs::Versions object. The argument is a reference to a -version comparison function, which must be usable by Perl's built-in C -function. - -=cut - -sub new -{ - my $this = shift; - my $class = ref($this) || $this; - my $vercmp = shift; - my $self = { parent => {}, vercmp => $vercmp }; - return bless $self, $class; -} - -=item isancestor - -Takes two arguments, C and C. Returns true if and only -if C is a version on which C is based according to the -version data supplied to this object. (As a degenerate case, this relation -is reflexive: a version is considered to be an ancestor of itself.) - -This method is expected mainly to be used internally by the C method. - -=cut - -sub isancestor -{ - my $self = shift; - my $ancestor = shift; - my $descendant = shift; - - my $parent = $self->{parent}; - for (my $node = $descendant; defined $node; $node = $parent->{$node}) { - return 1 if $node eq $ancestor; - } - - return 0; -} - -=item leaves - -Find the leaves of the version tree, i.e. those versions with no -descendants. - -This method is mainly for internal use. - -=cut - -sub leaves -{ - my $self = shift; - - my $parent = $self->{parent}; - my @vers = keys %$parent; - my %leaf; - @leaf{@vers} = (1) x @vers; - for my $v (@vers) { - delete $leaf{$parent->{$v}} if defined $parent->{$v}; - } - return keys %leaf; -} - -=item merge - -Merges one branch of version data into this object. This branch takes the -form of a list of versions, each of which is to be considered as based on -the next in the list. - -=cut - -sub merge -{ - my $self = shift; - return unless @_; - my $last = $_[0]; - for my $i (1 .. $#_) { - # Detect loops. - next if $self->isancestor($last, $_[$i]); - - # If it's already an ancestor version, don't add it again. This - # keeps the tree correct when we get several partial branches, such - # as '1.4.0 1.3.14 1.3.13 1.3.12' followed by '1.4.0 1.3.12 1.3.10'. - unless ($self->isancestor($_[$i], $last)) { - $self->{parent}{$last} = $_[$i]; - } - - $last = $_[$i]; - } - # Insert undef for the last version so that we can tell a known version - # by seeing if it exists in $self->{parent}. - $self->{parent}{$_[$#_]} = undef unless exists $self->{parent}{$_[$#_]}; -} - -=item load - -Loads version data from the filehandle passed as the argument. Each line of -input is expected to represent one branch, with versions separated by -whitespace. - -=cut - -sub load -{ - my $self = shift; - my $fh = shift; - local $_; - while (<$fh>) { - $self->merge(split); - } -} - -=item save - -Outputs the version tree represented by this object to the filehandle passed -as the argument. The format is the same as that expected by the C -method. - -=cut - -sub save -{ - my $self = shift; - my $fh = shift; - local $_; - my $parent = $self->{parent}; - - # TODO: breaks with tcp-wrappers/1.0-1 tcpd/2.0-1 case - my @leaves = reverse sort { - my ($x, $y) = ($a, $b); - $x =~ s{.*/}{}; - $y =~ s{.*/}{}; - $self->{vercmp}->($x, $y); - } $self->leaves(); - - my %seen; - for my $lf (@leaves) { - print $fh $lf; - $seen{$lf} = 1; - for (my $node = $parent->{$lf}; defined $node; - $node = $parent->{$node}) { - print $fh " $node"; - last if exists $seen{$node}; - $seen{$node} = 1; - } - print $fh "\n"; - } -} - -=item buggy - -Takes three arguments, C, C, and C. Returns true if -and only if C is based on or equal to a version in the list -referenced by C, and not based on or equal to one referenced by -C. - -C attempts to cope with found and fixed versions not in the version -tree by simply checking whether any fixed versions are recorded in the event -that nothing is known about any of the found versions. - -=cut - -sub buggy -{ - my $self = shift; - my $version = shift; - my $found = shift; - my $fixed = shift; - - my %found = map { $_ => 1 } @$found; - my %fixed = map { $_ => 1 } @$fixed; - my $parent = $self->{parent}; - for (my $node = $version; defined $node; $node = $parent->{$node}) { - # The found and fixed tests are this way round because the most - # likely scenario is that somebody thought they'd fixed a bug and - # then it was reopened because it turned out not to have been fixed - # after all. However, tools that build found and fixed lists should - # generally know the order of events and make sure that the two - # lists have no common entries. - return 'found' if $found{$node}; - return 'fixed' if $fixed{$node}; - } - - unless (@$found) { - # We don't know when it was found. Was it fixed in a descendant of - # this version? If so, this one should be considered buggy. - for my $f (@$fixed) { - for (my $node = $f; defined $node; $node = $parent->{$node}) { - return 'found' if $node eq $version; - } - } - } - - # Nothing in the requested version's ancestor chain can be confirmed as - # a version in which the bug was found or fixed. If it was only found or - # fixed on some other branch, then this one isn't buggy. - for my $f (@$found, @$fixed) { - return 'absent' if exists $parent->{$f}; - } - - # Otherwise, we degenerate to checking whether any fixed versions at all - # are recorded. - return 'fixed' if @$fixed; - return 'found'; -} - -=item allstates - -Takes two arguments, C and C, which are interpreted as in -L. Efficiently returns the state of the bug at every known version, -in the form of a hash from versions to states (as returned by L). If -you pass a third argument, C, this method will stop after -determining the state of the bug at all the versions listed therein. - -Whether this is faster than calling L for each version you're -interested in is not altogether clear, and depends rather strongly on the -number of known and interested versions. - -=cut - -sub allstates -{ - my $self = shift; - my $found = shift; - my $fixed = shift; - my $interested = shift; - - my %found = map { $_ => 1 } @$found; - my %fixed = map { $_ => 1 } @$fixed; - my %interested; - if (defined $interested) { - %interested = map { $_ => 1 } @$interested; - } - my $parent = $self->{parent}; - my @leaves = $self->leaves(); - - # Are any of the found or fixed versions known? We'll need this later. - my $known = 0; - for my $f (@$found, @$fixed) { - if (exists $parent->{$f}) { - $known = 1; - last; - } - } - - # Start at each leaf in turn, working our way up and remembering the - # list of versions in the branch. - my %state; - LEAF: for my $lf (@leaves) { - my @branch; - my $fixeddesc = 0; - - for (my $node = $lf; defined $node; $node = $parent->{$node}) { - # If we're about to start a new branch, check whether we know - # the state of every version in which we're interested. If so, - # we can stop now. - if (defined $interested and not @branch) { - my @remove; - for my $interest (keys %interested) { - if (exists $state{$interest}) { - push @remove, $interest; - } - } - delete @interested{@remove}; - last LEAF unless keys %interested; - } - - # We encounter a version whose state we already know. Record the - # branch with the same state as that version, and go on to the - # next leaf. - if (exists $state{$node}) { - $state{$_} = $state{$node} foreach @branch; - last; - } - - push @branch, $node; - - # We encounter a version in the found list. Record the branch as - # 'found', and start a new branch. - if ($found{$node}) { - $state{$_} = 'found' foreach @branch; - @branch = (); - } - - # We encounter a version in the fixed list. Record the branch as - # 'fixed', and start a new branch, remembering that we have a - # fixed descendant. - elsif ($fixed{$node}) { - $state{$_} = 'fixed' foreach @branch; - @branch = (); - $fixeddesc = 1; - } - - # We encounter a root. - elsif (not defined $parent->{$node}) { - # If the found list is empty and we have a fixed descendant, - # record the branch as 'found' (since they probably just - # forgot to report a version when opening the bug). - if (not @$found and $fixeddesc) { - $state{$_} = 'found' foreach @branch; - } - - # If any of the found or fixed versions are known, record - # the branch as 'absent' (since all the activity must have - # happened on some other branch). - elsif ($known) { - $state{$_} = 'absent' foreach @branch; - } - - # If there are any fixed versions at all (but they're - # unknown), then who knows, but we guess at recording the - # branch as 'fixed'. - elsif (@$fixed) { - $state{$_} = 'fixed' foreach @branch; - } - - # Otherwise, fall back to recording the branch as 'found'. - else { - $state{$_} = 'found' foreach @branch; - } - - # In any case, we're done. - last; - } - } - } - - return %state; -} - -=back - -=cut - -1;