From 79e24b055553a91bfae8596c304e77cb2a849f8a Mon Sep 17 00:00:00 2001
From: cjwatson <>
Date: Sun, 3 Aug 2003 08:49:22 -0800
Subject: [PATCH] [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.

---
 migrate/debbugs-makeversions | 176 +++++++++++++++++++++++++++++++++++
 1 file changed, 176 insertions(+)
 create mode 100755 migrate/debbugs-makeversions

diff --git a/migrate/debbugs-makeversions b/migrate/debbugs-makeversions
new file mode 100755
index 00000000..dfc565b7
--- /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;
-- 
2.39.5