[project @ 2003-08-03 09:49:22 by cjwatson]

Initial stab at a script to guess version information from an existing bug
database. This is definitely not the final form: in particular, it uses a
separate tree of .versions files for ease of testing rather than the real
.status files.

diff --git a/migrate/debbugs-makeversions b/migrate/debbugs-makeversions
new file mode 100755 (executable)
index 0000000..dfc565b
--- /dev/null
+++ b/migrate/debbugs-makeversions
@@ -0,0 +1,176 @@
+#! /usr/bin/perl -w
+# Extract version information from an existing non-versioned database by
+# guesswork, based on Version: pseudo-headers and closing mails that look
+# like Debian changelogs. The latter in particular is somewhat heuristic.
+
+use strict;
+use Debbugs::Log;
+use Debbugs::MIME;
+
+if (@ARGV != 2) {
+    print <<EOF;
+Usage: $0 db-directory versions-directory
+
+EOF
+    exit 0;
+}
+
+sub getbuginfo ($)
+{
+    my $log = shift;
+    print "Processing $log ...\n";
+
+    open LOG, "< $log" or die "Can't open $log: $!";
+    my @records = read_log_records(*LOG);
+    close LOG;
+
+    my (@found_versions, @fixed_versions);
+    my (%found_versions, %fixed_versions);
+
+    for my $record (@records) {
+       if ($record->{type} eq 'html') {
+           # Reassigns zap the found and fixed version list. Reopens will
+           # zap the fixed list too in the full deployment, but doing that
+           # here causes problems in case of accidental reopens and
+           # recloses.
+           if ($record->{text} =~ /assigned/) {
+               @found_versions = ();
+               %found_versions = ();
+               @fixed_versions = ();
+               %fixed_versions = ();
+           }
+           next;
+       }
+
+       next unless $record->{type} eq 'autocheck' or
+                   $record->{type} eq 'incoming-recv';
+       my $decoded = Debbugs::MIME::parse($record->{text});
+       next unless defined $decoded;
+
+       # Was it sent to -done or -close?
+       my $closing = 0;
+       my $firstreceived = $decoded->{header}[0];
+       if ($firstreceived =~ /\(at [^)]*-(?:done|close)\)/) {
+           $closing = 1;
+       }
+
+       # Get Version: pseudo-headers.
+       my $i;
+       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 ($closing) {
+           # 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};
+                   last;
+               }
+           }
+       }
+    }
+
+    return (\@found_versions, \@fixed_versions);
+}
+
+sub mergeinto ($$)
+{
+    my ($target, $source) = @_;
+    my %seen = map { $_ => 1 } @$target;
+    for my $v (@$source) {
+       next if exists $seen{$v};
+       push @$target, $v;
+       $seen{$v} = 1;
+    }
+}
+
+my ($db, $verdb) = @ARGV[0, 1];
+opendir DB, $db or die "Can't opendir $db: $!";
+unless (-d $verdb) {
+    mkdir $verdb or die "Can't mkdir $verdb: $!";
+}
+
+while (defined(my $dir = readdir DB)) {
+    next if $dir =~ /^\.\.?$/ or not -d "$db/$dir";
+    opendir HASH, "$db/$dir" or die "Can't opendir $db/$dir: $!";
+
+    while (defined(my $file = readdir HASH)) {
+       next unless $file =~ /\.log$/;
+       next if -z "$db/$dir/$file";
+       (my $bug = $file) =~ s/\..*//;
+
+       $bug =~ /(..)$/;
+       my $bughash = $1;
+       next if -e "$verdb/$bughash/$bug.versions" and
+               (stat "$verdb/$bughash/$bug.versions")[9] >=
+                   (stat "$db/$dir/$file")[9];
+
+       open STATUS, "$db/$dir/$bug.status" or next;
+       <STATUS> for 1 .. 6;    # done is field 7
+       chomp (my $done = <STATUS>);
+       <STATUS>;               # mergedwith is field 9
+       chomp (my $mergedwith = <STATUS>);
+       close STATUS;
+
+       my ($found_versions, $fixed_versions) = getbuginfo("$db/$dir/$file");
+
+       if (length $mergedwith) {
+           for my $merge (split ' ', $mergedwith) {
+               $merge =~ /(..)$/;
+               my $mergehash = $1;
+               my ($mfound, $mfixed) =
+                   getbuginfo("$db/$mergehash/$merge.log");
+               mergeinto($found_versions, $mfound);
+               mergeinto($fixed_versions, $mfixed);
+           }
+       }
+
+       @$fixed_versions = () unless length $done;
+
+       for my $out ($bug, (split ' ', $mergedwith)) {
+           $out =~ /(..)$/;
+           my $outhash = $1;
+
+           unless (-d "$verdb/$outhash") {
+               mkdir "$verdb/$outhash" or die "Can't mkdir $verdb/$outhash: $!";
+           }
+
+           open VERSIONS, "> $verdb/$outhash/$out.versions"
+               or die "Can't open $verdb/$outhash/$out.versions: $!";
+           print VERSIONS "Found-in: @$found_versions\n";
+           print VERSIONS "Fixed-in: @$fixed_versions\n";
+           close VERSIONS;
+       }
+    }
+
+    closedir HASH;
+}
+
+closedir DB;