Debbugs/Versions.pm

   1 package Debbugs::Versions;
   2
   3 use strict;
   4
   5 =head1 NAME
   6
   7 Debbugs::Versions - debbugs version information processing
   8
   9 =head1 DESCRIPTION
  10
  11 The Debbugs::Versions module provides generic support functions for the
  12 implementation of version tracking in debbugs.
  13
  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.
  21
  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.
  28
  29 =head1 DATA FORMAT
  30
  31 The data format looks like this (backslashes are not actually there, and
  32 indicate continuation lines):
  33
  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
  43
  44 =head1 METHODS
  45
  46 =over 8
  47
  48 =item new
  49
  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>
  52 function.
  53
  54 =cut
  55
  56 sub new ($$)
  57 {
  58     my $this = shift;
  59     my $class = ref($this) || $this;
  60     my $vercmp = shift;
  61     my $self = { parent => {}, vercmp => $vercmp };
  62     return bless $self, $class;
  63 }
  64
  65 =item isancestor
  66
  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.)
  71
  72 This method is expected mainly to be used internally by the C<merge> method.
  73
  74 =cut
  75
  76 sub isancestor ($$$)
  77 {
  78     my $self = shift;
  79     my $ancestor = shift;
  80     my $descendant = shift;
  81
  82     my $parent = $self->{parent};
  83     for (my $node = $descendant; defined $node; $node = $parent->{$node}) {
  84         return 1 if $node eq $ancestor;
  85     }
  86
  87     return 0;
  88 }
  89
  90 =item merge
  91
  92 Merges one branch of version data into this object. This branch takes the
  93 form of a list of versions, each of which is to be considered as based on
  94 the next in the list.
  95
  96 =cut
  97
  98 sub merge ($@)
  99 {
 100     my $self = shift;
 101     return unless @_;
 102     my $last = $_[0];
 103     for my $i (1 .. $#_) {
 104         # Detect loops.
 105         next if $self->isancestor($last, $_[$i]);
 106
 107         # If it's already an ancestor version, don't add it again. This
 108         # keeps the tree correct when we get several partial branches, such
 109         # as '1.4.0 1.3.14 1.3.13 1.3.12' followed by '1.4.0 1.3.12 1.3.10'.
 110         unless ($self->isancestor($_[$i], $last)) {
 111             $self->{parent}{$last} = $_[$i];
 112         }
 113
 114         $last = $_[$i];
 115     }
 116     # Insert undef for the last version so that we can tell a known version
 117     # by seeing if it exists in $self->{parent}.
 118     $self->{parent}{$_[$#_]} = undef;
 119 }
 120
 121 =item load
 122
 123 Loads version data from the filehandle passed as the argument. Each line of
 124 input is expected to represent one branch, with versions separated by
 125 whitespace.
 126
 127 =cut
 128
 129 sub load ($*)
 130 {
 131     my $self = shift;
 132     my $fh = shift;
 133     local $_;
 134     while (<$fh>) {
 135         $self->merge(split);
 136     }
 137 }
 138
 139 =item save
 140
 141 Outputs the version tree represented by this object to the filehandle passed
 142 as the argument. The format is the same as that expected by the C<load>
 143 method.
 144
 145 =cut
 146
 147 sub save ($*)
 148 {
 149     my $self = shift;
 150     my $fh = shift;
 151     local $_;
 152     my $parent = $self->{parent};
 153
 154     my @vers = keys %$parent;
 155     my %leaf;
 156     @leaf{@vers} = (1) x @vers;
 157     for my $v (@vers) {
 158         delete $leaf{$parent->{$v}} if defined $parent->{$v};
 159     }
 160     my @leaves = reverse sort { $self->{vercmp}->($a, $b) } keys %leaf;
 161
 162     my %seen;
 163     for my $lf (@leaves) {
 164         print $fh $lf;
 165         $seen{$lf} = 1;
 166         for (my $node = $parent->{$lf}; defined $node;
 167              $node = $parent->{$node}) {
 168             print $fh " $node";
 169             last if exists $seen{$node};
 170             $seen{$node} = 1;
 171         }
 172         print $fh "\n";
 173     }
 174 }
 175
 176 =item buggy
 177
 178 Takes three arguments, C<version>, C<found>, and C<fixed>. Returns true if
 179 and only if C<version> is based on or equal to a version in the list
 180 referenced by C<found>, and not based on or equal to one referenced by
 181 C<fixed>.
 182
 183 C<buggy> attempts to cope with found and fixed versions not in the version
 184 tree by simply checking whether any fixed versions are recorded in the event
 185 that nothing is known about any of the found versions.
 186
 187 =cut
 188
 189 sub buggy ($$$$)
 190 {
 191     my $self = shift;
 192     my $version = shift;
 193     my $found = shift;
 194     my $fixed = shift;
 195
 196     my %found = map { $_ => 1 } @$found;
 197     my %fixed = map { $_ => 1 } @$fixed;
 198     my $parent = $self->{parent};
 199     for (my $node = $version; defined $node; $node = $parent->{$node}) {
 200         # The found and fixed tests are this way round because the most
 201         # likely scenario is that somebody thought they'd fixed a bug and
 202         # then it was reopened because it turned out not to have been fixed
 203         # after all. However, tools that build found and fixed lists should
 204         # generally know the order of events and make sure that the two
 205         # lists have no common entries.
 206         return 'found' if $found{$node};
 207         return 'fixed' if $fixed{$node};
 208     }
 209
 210     # Nothing in the requested version's ancestor chain can be confirmed as
 211     # a version in which the bug was found or fixed. If it was only found or
 212     # fixed on some other branch, then this one isn't buggy.
 213     for my $f (@$found, @$fixed) {
 214         return 'absent' if exists $parent->{$f};
 215     }
 216
 217     # Otherwise, we degenerate to checking whether any fixed versions at all
 218     # are recorded.
 219     return 'fixed' if @$fixed;
 220     return 'found';
 221 }
 222
 223 =back
 224
 225 =cut
 226
 227 1;