--- /dev/null
+package Debbugs::Versions;
+
+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 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;
+}
+
+=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};
+
+ my @vers = keys %$parent;
+ my %leaf;
+ @leaf{@vers} = (1) x @vers;
+ for my $v (@vers) {
+ delete $leaf{$parent->{$v}} if defined $parent->{$v};
+ }
+ my @leaves = reverse sort { $self->{vercmp}->($a, $b) } keys %leaf;
+
+ 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};
+ }
+
+ # 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';
+}
+
+=back
+
+=cut
+
+1;
projects / debbugs.git / commitdiff