]> git.donarmstrong.com Git - debbugs.git/commitdiff
[project @ 2005-07-17 16:06:26 by cjwatson]
authorcjwatson <>
Sun, 17 Jul 2005 23:06:26 +0000 (15:06 -0800)
committercjwatson <>
Sun, 17 Jul 2005 23:06:26 +0000 (15:06 -0800)
Land branch-2_4_1-version-tracking.

Debbugs/Versions.pm
cgi/bugreport.cgi
cgi/common.pl
cgi/pkgreport.cgi
migrate/debbugs-makeversions
scripts/errorlib.in
scripts/process.in
scripts/service.in

index 3da63ce2be86824e63b915b1a4268011ee88f742..a5c697a2faa405fdfab02ae6f22d8cd9940d3943 100644 (file)
@@ -157,7 +157,13 @@ sub save ($*)
     for my $v (@vers) {
        delete $leaf{$parent->{$v}} if defined $parent->{$v};
     }
-    my @leaves = reverse sort { $self->{vercmp}->($a, $b) } keys %leaf;
+    # 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);
+    } keys %leaf;
 
     my %seen;
     for my $lf (@leaves) {
@@ -207,6 +213,16 @@ sub buggy ($$$$)
        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.
index f46cad8cc051da760ceee1b1851617cee8d66041..2514b6d741a422969c71e95190b8d257f6104c39 100755 (executable)
@@ -180,7 +180,7 @@ if  ($status{severity} eq 'normal') {
 }
 
 $indexentry .= "<p>$showseverity";
-$indexentry .= htmlpackagelinks($status{package}, 0);
+$indexentry .= htmlpackagelinks($status{package}, 0) . ";\n";
 
 $indexentry .= htmladdresslinks("Reported by: ", \&submitterurl,
                                 $status{originator}) . ";\n";
index 74da3c45b571807a38fee568f5b222fdecf9cc21..6032390b571157301c7dcafe8507333aed7f0f71 100644 (file)
@@ -243,7 +243,7 @@ sub htmlpackagelinks {
                     '<a href="' . pkgurl($_) . '">' .
                     $openstrong . htmlsanit($_) . $closestrong . '</a>'
                 } @pkglist
-           ) . ";\n";
+           );
 }
 
 # Generate a comma-separated list of HTML links to each address given in
@@ -296,6 +296,25 @@ sub htmlindexentrystatus {
     }
 
     $result .= htmlpackagelinks($status{"package"}, 1);
+
+    my $showversions = '';
+    if (@{$status{found_versions}}) {
+        my @found = @{$status{found_versions}};
+        local $_;
+        s{/}{ } foreach @found;
+        $showversions .= join ', ', map htmlsanit($_), @found;
+    }
+    if (@{$status{fixed_versions}}) {
+        $showversions .= '; ' if length $showversions;
+        $showversions .= '<strong>fixed</strong>: ';
+        my @fixed = @{$status{fixed_versions}};
+        local $_;
+        s{/}{ } foreach @fixed;
+        $showversions .= join ', ', map htmlsanit($_), @fixed;
+    }
+    $result .= " ($showversions)" if length $showversions;
+    $result .= ";\n";
+
     $result .= $showseverity;
     $result .= htmladdresslinks("Reported by: ", \&submitterurl,
                                 $status{originator});
@@ -313,22 +332,7 @@ sub htmlindexentrystatus {
         $mseparator= ", ";
     }
 
-    if (@{$status{found_versions}}) {
-        $result .= ";\nfound in ";
-        $result .= (@{$status{found_versions}} == 1) ? 'version '
-                                                     : 'versions ';
-        $result .= join ', ', map htmlsanit($_), @{$status{found_versions}};
-    }
-
-    if (@{$status{fixed_versions}}) {
-        $result .= ";\n<strong>fixed</strong> in ";
-        $result .= (@{$status{fixed_versions}} == 1) ? 'version '
-                                                     : 'versions ';
-        $result .= join ', ', map htmlsanit($_), @{$status{fixed_versions}};
-        if (length($status{done})) {
-            $result .= ' by ' . htmlsanit($status{done});
-        }
-    } elsif (length($status{done})) {
+    if (length($status{done})) {
         $result .= ";\n<strong>Done:</strong> " . htmlsanit($status{done});
         $days = ceil($debbugs::gRemoveAge - -M buglog($status{id}));
         if ($days >= 0) {
@@ -811,24 +815,40 @@ sub getbugstatus {
     $status{"pending"} = 'pending-fixed'    if ($tags{pending});
     $status{"pending"} = 'fixed'           if ($tags{fixed});
 
-    my $version;
+    my @versions;
     if (defined $common_version) {
-        $version = $common_version;
+        @versions = ($common_version);
     } elsif (defined $common_dist) {
-        $version = getversion($status{package}, $common_dist, $common_arch);
+        @versions = getversions($status{package}, $common_dist, $common_arch);
     }
 
-    if (defined $version) {
-        my $buggy = buggyversion($bugnum, $version, \%status);
-        if ($buggy eq 'absent') {
+    # TODO: This should probably be handled further out for efficiency and
+    # for more ease of distinguishing between pkg= and src= queries.
+    my @sourceversions = makesourceversions($status{package}, $common_arch,
+                                            @versions);
+
+    if (@sourceversions) {
+        # Resolve bugginess states (we might be looking at multiple
+        # architectures, say). Found wins, then fixed, then absent.
+        my $maxbuggy = 'absent';
+        for my $version (@sourceversions) {
+            my $buggy = buggyversion($bugnum, $version, \%status);
+            if ($buggy eq 'found') {
+                $maxbuggy = 'found';
+                last;
+            } elsif ($buggy eq 'fixed' and $maxbuggy ne 'found') {
+                $maxbuggy = 'fixed';
+            }
+        }
+        if ($maxbuggy eq 'absent') {
             $status{"pending"} = 'absent';
-        } elsif ($buggy eq 'fixed') {
+        } elsif ($maxbuggy eq 'fixed') {
             $status{"pending"} = 'done';
         }
     }
     
     if (length($status{done}) and
-            (not defined $version or not @{$status{fixed_versions}})) {
+            (not @sourceversions or not @{$status{fixed_versions}})) {
         $status{"pending"} = 'done';
     }
 
@@ -854,6 +874,29 @@ sub buglog {
     return getbugcomponent($bugnum, 'log.gz', $location);
 }
 
+# Canonicalize versions into source versions, which have an explicitly
+# named source package. This is used to cope with source packages whose
+# names have changed during their history, and with cases where source
+# version numbers differ from binary version numbers.
+sub makesourceversions {
+    my $pkg = shift;
+    my $arch = shift;
+    my %sourceversions;
+
+    for my $version (@_) {
+        if ($version =~ m[/]) {
+            # Already a source version.
+            $sourceversions{$version} = 1;
+        } else {
+            my @srcinfo = binarytosource($pkg, $version, $arch);
+            next unless @srcinfo;
+            $sourceversions{"$_->[0]/$_->[1]"} = 1 foreach @srcinfo;
+        }
+    }
+
+    return sort keys %sourceversions;
+}
+
 my %_versionobj;
 sub buggyversion {
     my ($bug, $ver, $status) = @_;
@@ -866,30 +909,136 @@ sub buggyversion {
         $tree = $_versionobj{$src};
     } else {
         $tree = Debbugs::Versions->new(\&DpkgVer::vercmp);
-        if (open VERFILE, "< $gVersionPackagesDir/$src") {
+        my $srchash = substr $src, 0, 1;
+        if (open VERFILE, "< $gVersionPackagesDir/$srchash/$src") {
             $tree->load(\*VERFILE);
             close VERFILE;
         }
         $_versionobj{$src} = $tree;
     }
 
-    return $tree->buggy($ver, $status->{found_versions},
-                        $status->{fixed_versions});
+    my @found = makesourceversions($status->{package}, undef,
+                                   @{$status->{found_versions}});
+    my @fixed = makesourceversions($status->{package}, undef,
+                                   @{$status->{fixed_versions}});
+
+    return $tree->buggy($ver, \@found, \@fixed);
 }
 
 my %_versions;
-sub getversion {
+sub getversions {
     my ($pkg, $dist, $arch) = @_;
-    return undef unless defined $gVersionIndex;
+    return () unless defined $gVersionIndex;
     $dist = 'unstable' unless defined $dist;
-    $arch = 'i386' unless defined $arch;
 
     unless (tied %_versions) {
         tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY
             or die "can't open versions index: $!";
     }
 
-    return $_versions{$pkg}{$dist}{$arch};
+    if (defined $arch) {
+        my $ver = $_versions{$pkg}{$dist}{$arch};
+        return $ver if defined $ver;
+        return ();
+    } else {
+        my %uniq;
+        for my $ar (keys %{$_versions{$pkg}{$dist}}) {
+            $uniq{$_versions{$pkg}{$dist}{$ar}} = 1 unless $ar eq 'source';
+        }
+        return keys %uniq;
+    }
+}
+
+sub getversiondesc {
+    my $pkg = shift;
+
+    if (defined $common_version) {
+        return "version $common_version";
+    } elsif (defined $common_dist) {
+        my @distvers = getversions($pkg, $common_dist, $common_arch);
+        @distvers = sort @distvers;
+        local $" = ', ';
+        if (@distvers > 1) {
+            return "versions @distvers";
+        } elsif (@distvers == 1) {
+            return "version @distvers";
+        }
+    }
+
+    return undef;
+}
+
+# Returns an array of zero or more references to (srcname, srcver) pairs.
+# If $binarch is undef, returns results for all architectures.
+my %_binarytosource;
+sub binarytosource {
+    my ($binname, $binver, $binarch) = @_;
+
+    # TODO: This gets hit a lot, especially from buggyversion() - probably
+    # need an extra cache for speed here.
+
+    if (tied %_binarytosource or
+           tie %_binarytosource, 'MLDBM', $gBinarySourceMap, O_RDONLY) {
+       # avoid autovivification
+       if (exists $_binarytosource{$binname} and
+               exists $_binarytosource{$binname}{$binver}) {
+           if (defined $binarch) {
+               my $src = $_binarytosource{$binname}{$binver}{$binarch};
+               return () unless defined $src; # not on this arch
+               # Copy the data to avoid tiedness problems.
+               return [@$src];
+           } else {
+               # Get (srcname, srcver) pairs for all architectures and
+               # remove any duplicates. This involves some slightly tricky
+               # multidimensional hashing; sorry. Fortunately there'll
+               # usually only be one pair returned.
+               my %uniq;
+               for my $ar (keys %{$_binarytosource{$binname}{$binver}}) {
+                   my $src = $_binarytosource{$binname}{$binver}{$ar};
+                   next unless defined $src;
+                   $uniq{$src->[0]}{$src->[1]} = 1;
+               }
+               my @uniq;
+               for my $sn (sort keys %uniq) {
+                   push @uniq, [$sn, $_] for sort keys %{$uniq{$sn}};
+               }
+               return @uniq;
+           }
+       }
+    }
+
+    # No $gBinarySourceMap, or it didn't have an entry for this name and
+    # version. Try $gPackageSource (unversioned) instead.
+    my $pkgsrc = getpkgsrc();
+    if (exists $pkgsrc->{$binname}) {
+       return [$pkgsrc->{$binname}, $binver];
+    } else {
+       return ();
+    }
+}
+
+# Returns an array of zero or more references to
+# (binname, binver[, binarch]) triplets.
+my %_sourcetobinary;
+sub sourcetobinary {
+    my ($srcname, $srcver) = @_;
+
+    if (tied %_sourcetobinary or
+           tie %_sourcetobinary, 'MLDBM', $gSourceBinaryMap, O_RDONLY) {
+       # avoid autovivification
+       if (exists $_sourcetobinary{$srcname} and
+               exists $_sourcetobinary{$srcname}{$srcver}) {
+           my $bin = $_sourcetobinary{$srcname}{$srcver};
+           return () unless defined $bin;
+           # Copy the data to avoid tiedness problems.
+           return @$bin;
+       }
+    }
+
+    # No $gSourceBinaryMap, or it didn't have an entry for this name and
+    # version. Try $gPackageSource (unversioned) instead.
+    my @srcpkgs = getsrcpkgs($srcname);
+    return map [$_, $srcver], @srcpkgs;
 }
 
 1;
index f8b3242447d233b61d5337b1dbc131f2788b5843..74bf6065eab61dff3f0b4cc9ef4e073bc5db3a7a 100755 (executable)
@@ -125,8 +125,8 @@ if (defined $pkg) {
     $title .= " (version $version)";
   } elsif (defined $dist) {
     $title .= " in $dist";
-    my $distver = getversion($pkg, $dist, $arch);
-    $title .= " (version $distver)" if defined $distver;
+    my $verdesc = getversiondesc($pkg);
+    $title .= " ($verdesc)" if defined $verdesc;
   }
   my @pkgs = split /,/, $pkg;
   @bugs = @{getbugs(sub {my %d=@_;
@@ -137,12 +137,13 @@ if (defined $pkg) {
                         }, 'package', @pkgs)};
 } elsif (defined $src) {
   $title = "source $src";
+  set_option('arch', 'source');
   if (defined $version) {
     $title .= " (version $version)";
   } elsif (defined $dist) {
     $title .= " in $dist";
-    my $distver = getversion($src, $dist, 'source');
-    $title .= " (version $distver)" if defined $distver;
+    my $verdesc = getversiondesc($src);
+    $title .= " ($verdesc)" if defined $verdesc;
   }
   my @pkgs = ();
   my @srcs = split /,/, $src;
index dfc565b7c8c6063de09cfd74d66e4f2844c06333..234d0fdb6c3f47ad5c4819df106dea28e49a8de9 100755 (executable)
@@ -18,7 +18,6 @@ EOF
 sub getbuginfo ($)
 {
     my $log = shift;
-    print "Processing $log ...\n";
 
     open LOG, "< $log" or die "Can't open $log: $!";
     my @records = read_log_records(*LOG);
@@ -56,27 +55,46 @@ sub getbuginfo ($)
 
        # Get Version: pseudo-headers.
        my $i;
+       my ($source, $sourcever, $ver);
        for ($i = 0; $i < @{$decoded->{body}}; ++$i) {
            last if $decoded->{body}[$i] !~ /^(\S+):\s*(.*)/;
            my ($fn, $fv) = (lc $1, $2);
-           next if $fn ne 'version';
-           next if $fv !~ /^(\d[^,\s]*(?:[,\s]+|$))+/;
-           if ($closing) {
-               for my $v (split /[,\s]+/, $fv) {
-                   push @fixed_versions, $v
-                       unless exists $fixed_versions{$v};
-                   $fixed_versions{$v} = 1;
-                   @found_versions = grep { $_ ne $v } @found_versions;
-                   delete $found_versions{$v};
-               }
-           } else {
-               for my $v (split /[,\s]+/, $fv) {
-                   push @found_versions, $v
-                       unless exists $found_versions{$v};
-                   $found_versions{$v} = 1;
-                   @fixed_versions = grep { $_ ne $v } @fixed_versions;
-                   delete $fixed_versions{$v};
-               }
+           if ($fn eq 'source') {
+               $source = $fv;
+           } elsif ($fn eq 'source-version' and
+                    $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
+               $sourcever = $fv;
+           } elsif ($fn eq 'version' and $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
+               # Deal with reportbug brain-damage.
+               next if $fv =~ /^unavailable/i;
+               $fv =~ s/;.*//;
+               $fv =~ s/ *\(.*\)//;
+               $ver = $fv;
+           }
+       }
+
+       my @parsedvers;
+       if (defined $ver) {
+           push @parsedvers, split /[,\s]+/, $ver;
+       } elsif (defined $source and defined $sourcever) {
+           push @parsedvers, map "$source/$_", split /[,\s]+/, $sourcever;
+       }
+
+       if ($closing) {
+           for my $v (@parsedvers) {
+               push @fixed_versions, $v
+                   unless exists $fixed_versions{$v};
+               $fixed_versions{$v} = 1;
+               @found_versions = grep { $_ ne $v } @found_versions;
+               delete $found_versions{$v};
+           }
+       } else {
+           for my $v (@parsedvers) {
+               push @found_versions, $v
+                   unless exists $found_versions{$v};
+               $found_versions{$v} = 1;
+               @fixed_versions = grep { $_ ne $v } @fixed_versions;
+               delete $fixed_versions{$v};
            }
        }
 
@@ -84,13 +102,13 @@ sub getbuginfo ($)
            # Look for Debian changelogs.
            for (; $i < @{$decoded->{body}}; ++$i) {
                if ($decoded->{body}[$i] =~
-                       /\S+ \(([^)]+)\) \S+; urgency=\S+/i) {
-                   my $v = $1;
-                   push @fixed_versions, $v
-                       unless exists $fixed_versions{$v};
-                   $fixed_versions{$v} = 1;
-                   @found_versions = grep { $_ ne $v } @found_versions;
-                   delete $found_versions{$v};
+                       /(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\) \S+; urgency=\S+/i) {
+                   my ($p, $v) = ($1, $2);
+                   push @fixed_versions, "$p/$v"
+                       unless exists $fixed_versions{"$p/$v"};
+                   $fixed_versions{"$p/$v"} = 1;
+                   @found_versions = grep { $_ ne "$p/$v" } @found_versions;
+                   delete $found_versions{"$p/$v"};
                    last;
                }
            }
@@ -128,9 +146,12 @@ while (defined(my $dir = readdir DB)) {
 
        $bug =~ /(..)$/;
        my $bughash = $1;
-       next if -e "$verdb/$bughash/$bug.versions" and
-               (stat "$verdb/$bughash/$bug.versions")[9] >=
-                   (stat "$db/$dir/$file")[9];
+       # For incremental updates.
+       #next if -e "$verdb/$bughash/$bug.versions" and
+       #       (stat "$verdb/$bughash/$bug.versions")[9] >=
+       #           (stat "$db/$dir/$file")[9];
+
+       print "Processing $bug ...\n" if $ENV{DEBBUGS_VERBOSE};
 
        open STATUS, "$db/$dir/$bug.status" or next;
        <STATUS> for 1 .. 6;    # done is field 7
index cdf18557e7db8176727517be3bc442c600900627..a8faf3d0da22225f9926efc44ddeb17931f6e3a7 100755 (executable)
@@ -1,5 +1,5 @@
 # -*- perl -*-
-# $Id: errorlib.in,v 1.42 2005/04/09 16:21:02 cjwatson Exp $
+# $Id: errorlib.in,v 1.43 2005/07/17 16:06:26 cjwatson Exp $
 
 use Mail::Address;
 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
@@ -85,6 +85,8 @@ my %fields = (originator => 'submitter',
               mergedwith => 'merged-with',
               severity => 'severity',
               owner => 'owner',
+              found_versions => 'found-in',
+              fixed_versions => 'fixed-in',
              );
 
 # Fields which need to be RFC1522-decoded in format versions earlier than 3.
@@ -123,7 +125,9 @@ sub readbug {
 
     close(S);
 
-    $data{severity} = 'normal' if $data{severity} eq '';
+    $data{severity} = $gDefaultSeverity if $data{severity} eq '';
+    $data{found_versions} = [split ' ', $data{found_versions}];
+    $data{fixed_versions} = [split ' ', $data{fixed_versions}];
 
     if ($version < 3) {
        for my $field (@rfc1522_fields) {
@@ -147,6 +151,9 @@ sub makestatus {
     my $version = shift;
     $version = 2 unless defined $version;
 
+    local $data->{found_versions} = join ' ', @{$data->{found_versions}};
+    local $data->{fixed_versions} = join ' ', @{$data->{fixed_versions}};
+
     my $contents = '';
 
     my %newdata = %$data;
@@ -254,6 +261,68 @@ sub unfilelock {
     unlink($lockfile) || warn "failed to remove lock file $lockfile: $!";
 }
 
+sub addfoundversions {
+    my $data = shift;
+    my $source = shift;
+    my $version = shift;
+    return unless defined $version;
+    undef $source if $source =~ m[(?:\s|/)];
+
+    foreach my $ver (split /[,\s]+/, $version) {
+        $ver = "$source/$ver" if defined $source;
+        unless (grep { $_ eq $ver } @{$data->{found_versions}}) {
+            push @{$data->{found_versions}}, $ver;
+        }
+        @{$data->{fixed_versions}} =
+            grep { $_ ne $ver } @{$data->{fixed_versions}};
+    }
+}
+
+sub removefoundversions {
+    my $data = shift;
+    my $source = shift;
+    my $version = shift;
+    return unless defined $version;
+    undef $source if $source =~ m[(?:\s|/)];
+
+    foreach my $ver (split /[,\s]+/, $version) {
+        $ver = "$source/$ver" if defined $source;
+        @{$data->{found_versions}} =
+            grep { $_ ne $ver } @{$data->{found_versions}};
+    }
+}
+
+sub addfixedversions {
+    my $data = shift;
+    my $source = shift;
+    my $version = shift;
+    return unless defined $version;
+    undef $source if $source =~ m[(?:\s|/)];
+
+    foreach my $ver (split /[,\s]+/, $version) {
+        $ver = "$source/$ver" if defined $source;
+        unless (grep { $_ eq $ver } @{$data->{fixed_versions}}) {
+            push @{$data->{fixed_versions}}, $ver;
+        }
+        @{$data->{found_versions}} =
+            grep { $_ ne $ver } @{$data->{found_versions}};
+    }
+}
+
+sub removefixedversions {
+    my $data = shift;
+    my $source = shift;
+    my $version = shift;
+    return unless defined $version;
+    undef $source if $source =~ m[(?:\s|/)];
+
+    foreach my $ver (split /[,\s]+/, $version) {
+        $ver = "$source/$ver" if defined $source;
+        @{$data->{fixed_versions}} =
+            grep { $_ ne $ver } @{$data->{fixed_versions}};
+    }
+}
+
 sub quit {
     print DEBUG "quitting >$_[0]<\n";
     local ($u);
index b6415562f18a4a8c48468a6f852b38bac3e08ac7..6d83dc5ac167201a7d2f9d7e9e328ba0813a1d9a 100755 (executable)
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: process.in,v 1.92 2005/07/16 21:13:16 don Exp $
+# $Id: process.in,v 1.93 2005/07/17 16:06:26 cjwatson Exp $
 #
 # Usage: process nn
 # Temps:  incoming/Pnn
@@ -349,6 +349,11 @@ END
         if ($codeletter eq 'D') {
             $data->{keywords} = join ' ', grep $_ ne 'pending',
                                      split ' ', $data->{keywords};
+            if (defined $pheader{'source-version'}) {
+                addfixedversions($data, $pheader{source}, $pheader{'source-version'});
+            } elsif (defined $pheader{version}) {
+                addfixedversions($data, undef, $pheader{version});
+            }
         }
 
        writebug($ref, $data);
@@ -499,7 +504,15 @@ END
        &appendlog;
        &finish;
     }
-    if (!defined($pheader{'package'})) {
+
+    $data->{found_versions} = [];
+    $data->{fixed_versions} = [];
+
+    if (defined $pheader{source}) {
+        $data->{package} = $pheader{source};
+    } elsif (defined $pheader{package}) {
+        $data->{package} = $pheader{package};
+    } else {
        &htmllog("Warning","sent",$replyto,"Message not forwarded.");
         &sendmessage(<<END."---------------------------------------------------------------------------\n".join("\n", @msg), '');
 From: $gMaintainerEmail ($gProject $gBug Tracking System)
@@ -535,21 +548,6 @@ $gMaintainer
 END
        &appendlog;
        &finish;
-    } else {
-       $data->{package}= $pheader{'package'}; 
-    }
-
-    $data->{versions}= '';
-    if (defined($pheader{'version'})) {
-        $data->{versions} = $pheader{'version'};
-        $data->{versions} =~ s/\s+/ /;
-       # BUG: need to bounce unknown versions back to submitter here
-    }
-
-    $data->{fixed_versions}= '';
-    if (defined($pheader{'fixed-in-version'})) {
-        $data->{fixed_versions} = $pheader{'fixed-in-version'};
-        $data->{fixed_versions} =~ s/\s+/ /;
     }
 
     $data->{keywords}= '';
@@ -637,6 +635,22 @@ if (defined $gStrongList and isstrongseverity($data->{severity})) {
     push @bccs, "$gStrongList\@$gListDomain";
 }
 
+if (defined $pheader{source}) {
+    # Prefix source versions with the name of the source package. They
+    # appear that way in version trees so that we can deal with binary
+    # packages moving from one source package to another.
+    if (defined $pheader{'source-version'}) {
+        addfoundversions($data, $pheader{source}, $pheader{'source-version'});
+    } elsif (defined $pheader{version}) {
+        addfoundversions($data, $pheader{source}, $pheader{version});
+    }
+    writebug($ref, $data);
+} elsif (defined $pheader{package}) {
+    # TODO: could handle Source-Version: by looking up the source package?
+    addfoundversions($data, undef, $pheader{version}) if defined($pheader{version});
+    writebug($ref, $data);
+}
+
 $veryquiet= $codeletter eq 'Q';
 if ($codeletter eq 'M' && !@maintaddrs) {
     $veryquiet= 1;
index 3231590b3f5966ab18aa1e2281ff4cfc024fbf82..2e909e1f44824035bb99861f57a2f5b6aacfd694 100755 (executable)
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: service.in,v 1.100 2005/05/26 13:30:21 cjwatson Exp $
+# $Id: service.in,v 1.101 2005/07/17 16:06:26 cjwatson Exp $
 #
 # Usage: service <code>.nn
 # Temps:  incoming/P<code>.nn
@@ -242,16 +242,21 @@ END
             last;
         }
 #### interesting ones start here
-    } elsif (m/^close\s+\#?(-?\d+)$/i) {
+    } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
        $ok++;
        $ref= $1;
+       $version= $2;
        if (&setbug) {
            &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
-           if (length($data->{done})) {
+           if (length($data->{done}) and not defined($version)) {
                &transcript("$gBug is already closed, cannot re-close.\n\n");
                 &nochangebug;
             } else {
-                $action= "$gBug closed, send any further explanations to $data->{originator}";
+                $action= "$gBug " .
+                    (defined($version) ?
+                        "marked as fixed in version $version" :
+                        "closed") .
+                    ", send any further explanations to $data->{originator}";
                 do {
                     &addmaintainers($data);
                                        if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
@@ -263,6 +268,7 @@ END
                         $data->{keywords}= join ' ', grep $_ ne 'pending',
                                                 @keywords;
                     }
+                    addfixedversions($data, undef, $version);
 
                    $message= <<END;
 From: $gMaintainerEmail ($gProject $gBug Tracking System)
@@ -293,9 +299,10 @@ END
                 } while (&getnextbug);
             }
         }
-    } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
+    } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
         $ok++;
         $ref= $1; $newpackage= $2;
+        $version= $3;
        $newpackage =~ y/A-Z/a-z/;
         if (&setbug) {
             if (length($data->{package})) {
@@ -307,6 +314,10 @@ END
             do {
                 &addmaintainers($data);
                 $data->{package}= $newpackage;
+                $data->{found_versions}= [];
+                $data->{fixed_versions}= [];
+                # TODO: what if $newpackage is a source package?
+                addfoundversions($data, undef, $version) if defined $version;
                 &addmaintainers($data);
             } while (&getnextbug);
         }
@@ -317,6 +328,9 @@ END
         $ok++;
         $ref= $1;
         if (&setbug) {
+            if (@{$data->{fixed_versions}}) {
+                &transcript("'reopen' is deprecated when a bug has been closed with a version;\nuse 'found' or 'submitter' as appropriate instead.\n");
+            }
             if (!length($data->{done})) {
                 &transcript("$gBug is already open, cannot reopen.\n\n");
                 &nochangebug;
@@ -331,6 +345,46 @@ END
                 } while (&getnextbug);
             }
         }
+    } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
+        $ok++;
+        $ref= $1;
+        $version= $2;
+        if (&setbug) {
+            if (!length($data->{done})) {
+                &transcript("$gBug is already open, cannot reopen.\n\n");
+                &nochangebug;
+            } else {
+                $action=
+                    defined($version) ?
+                        "$gBug marked as found in version $version." :
+                        "$gBug reopened.";
+                do {
+                    &addmaintainers($data);
+                    # The 'done' field gets a bit weird with version
+                    # tracking, because a bug may be closed by multiple
+                    # people in different branches. Until we have something
+                    # more flexible, we set it every time a bug is fixed,
+                    # and clear it precisely when a found command is
+                    # received for the rightmost fixed-in version, which
+                    # equates to the most recent fixing of the bug, or when
+                    # a versionless found command is received.
+                    if (defined $version) {
+                        my $lastfixed =
+                            (reverse @{$data->{fixed_versions}})[0];
+                        # TODO: what if $data->{package} is a source package?
+                        addfoundversions($data, undef, $version);
+                        if (defined $lastfixed and $version eq $lastfixed) {
+                            $data->{done} = '';
+                        }
+                    } else {
+                        # Versionless found; assume old-style "not fixed at
+                        # all".
+                        $data->{fixed_versions} = [];
+                        $data->{done} = '';
+                    }
+                } while (&getnextbug);
+            }
+        }
     } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
              m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
         $ok++;