2 # Extract version information from an existing non-versioned database by
3 # guesswork, based on Version: pseudo-headers and closing mails that look
4 # like Debian changelogs. The latter in particular is somewhat heuristic.
12 Usage: $0 db-directory versions-directory
21 #print "Processing $log ...\n";
23 open LOG, "< $log" or die "Can't open $log: $!";
24 my @records = read_log_records(*LOG);
27 my (@found_versions, @fixed_versions);
28 my (%found_versions, %fixed_versions);
30 for my $record (@records) {
31 if ($record->{type} eq 'html') {
32 # Reassigns zap the found and fixed version list. Reopens will
33 # zap the fixed list too in the full deployment, but doing that
34 # here causes problems in case of accidental reopens and
36 if ($record->{text} =~ /assigned/) {
45 next unless $record->{type} eq 'autocheck' or
46 $record->{type} eq 'incoming-recv';
47 my $decoded = Debbugs::MIME::parse($record->{text});
48 next unless defined $decoded;
50 # Was it sent to -done or -close?
52 my $firstreceived = $decoded->{header}[0];
53 if ($firstreceived =~ /\(at [^)]*-(?:done|close)\)/) {
57 # Get Version: pseudo-headers.
59 my ($source, $sourcever, $ver);
60 for ($i = 0; $i < @{$decoded->{body}}; ++$i) {
61 last if $decoded->{body}[$i] !~ /^(\S+):\s*(.*)/;
62 my ($fn, $fv) = (lc $1, $2);
63 if ($fn eq 'source') {
65 } elsif ($fn eq 'source-version' and
66 $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
68 } elsif ($fn eq 'version' and $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
69 # Deal with reportbug brain-damage.
70 next if $fv =~ /^unavailable/i;
79 push @parsedvers, split /[,\s]+/, $ver;
80 } elsif (defined $source and defined $sourcever) {
81 push @parsedvers, map "$source/$_", split /[,\s]+/, $sourcever;
85 for my $v (@parsedvers) {
86 push @fixed_versions, $v
87 unless exists $fixed_versions{$v};
88 $fixed_versions{$v} = 1;
89 @found_versions = grep { $_ ne $v } @found_versions;
90 delete $found_versions{$v};
93 for my $v (@parsedvers) {
94 push @found_versions, $v
95 unless exists $found_versions{$v};
96 $found_versions{$v} = 1;
97 @fixed_versions = grep { $_ ne $v } @fixed_versions;
98 delete $fixed_versions{$v};
103 # Look for Debian changelogs.
104 for (; $i < @{$decoded->{body}}; ++$i) {
105 if ($decoded->{body}[$i] =~
106 /(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\) \S+; urgency=\S+/i) {
107 my ($p, $v) = ($1, $2);
108 push @fixed_versions, "$p/$v"
109 unless exists $fixed_versions{"$p/$v"};
110 $fixed_versions{"$p/$v"} = 1;
111 @found_versions = grep { $_ ne "$p/$v" } @found_versions;
112 delete $found_versions{"$p/$v"};
119 return (\@found_versions, \@fixed_versions);
124 my ($target, $source) = @_;
125 my %seen = map { $_ => 1 } @$target;
126 for my $v (@$source) {
127 next if exists $seen{$v};
133 my ($db, $verdb) = @ARGV[0, 1];
134 opendir DB, $db or die "Can't opendir $db: $!";
136 mkdir $verdb or die "Can't mkdir $verdb: $!";
139 while (defined(my $dir = readdir DB)) {
140 next if $dir =~ /^\.\.?$/ or not -d "$db/$dir";
141 opendir HASH, "$db/$dir" or die "Can't opendir $db/$dir: $!";
143 while (defined(my $file = readdir HASH)) {
144 next unless $file =~ /\.log$/;
145 next if -z "$db/$dir/$file";
146 (my $bug = $file) =~ s/\..*//;
150 #next if -e "$verdb/$bughash/$bug.versions" and
151 # (stat "$verdb/$bughash/$bug.versions")[9] >=
152 # (stat "$db/$dir/$file")[9];
154 print "Processing $bug ...\n" if $ENV{DEBBUGS_VERBOSE};
156 open STATUS, "$db/$dir/$bug.status" or next;
157 <STATUS> for 1 .. 6; # done is field 7
158 chomp (my $done = <STATUS>);
159 <STATUS>; # mergedwith is field 9
160 chomp (my $mergedwith = <STATUS>);
163 my ($found_versions, $fixed_versions) = getbuginfo("$db/$dir/$file");
165 if (length $mergedwith) {
166 for my $merge (split ' ', $mergedwith) {
169 my ($mfound, $mfixed) =
170 getbuginfo("$db/$mergehash/$merge.log");
171 mergeinto($found_versions, $mfound);
172 mergeinto($fixed_versions, $mfixed);
176 @$fixed_versions = () unless length $done;
178 for my $out ($bug, (split ' ', $mergedwith)) {
182 unless (-d "$verdb/$outhash") {
183 mkdir "$verdb/$outhash" or die "Can't mkdir $verdb/$outhash: $!";
186 open VERSIONS, "> $verdb/$outhash/$out.versions"
187 or die "Can't open $verdb/$outhash/$out.versions: $!";
188 print VERSIONS "Found-in: @$found_versions\n";
189 print VERSIONS "Fixed-in: @$fixed_versions\n";