+++ /dev/null
-# 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<sort>
-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<ancestor> and C<descendant>. Returns true if and only
-if C<ancestor> is a version on which C<descendant> 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<merge> 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<load>
-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<version>, C<found>, and C<fixed>. Returns true if
-and only if C<version> is based on or equal to a version in the list
-referenced by C<found>, and not based on or equal to one referenced by
-C<fixed>.
-
-C<buggy> 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<found> and C<fixed>, which are interpreted as in
-L</buggy>. 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</buggy>). If
-you pass a third argument, C<interested>, this method will stop after
-determining the state of the bug at all the versions listed therein.
-
-Whether this is faster than calling L</buggy> 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;
projects / debbugs.git / blobdiff