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.
6 my $config_path = '/etc/debbugs';
7 my $lib_path = '/usr/lib/debbugs';
9 require "$config_path/config";
10 require "$lib_path/errorlib";
17 Usage: $0 db-type versions-directory
27 open LOG, "< $log" or die "Can't open $log: $!";
28 my @records = read_log_records(*LOG);
31 my (@found_versions, @fixed_versions);
32 my (%found_versions, %fixed_versions);
34 for my $record (@records) {
35 if ($record->{type} eq 'html') {
36 # Reassigns zap the found and fixed version list. Reopens will
37 # zap the fixed list too in the full deployment, but doing that
38 # here causes problems in case of accidental reopens and
40 if ($record->{text} =~ /assigned/) {
49 next unless $record->{type} eq 'autocheck' or
50 $record->{type} eq 'incoming-recv';
51 my $decoded = Debbugs::MIME::parse($record->{text});
52 next unless defined $decoded;
54 # Was it sent to -done or -close?
56 my $firstreceived = $decoded->{header}[0];
57 if ($firstreceived =~ /\(at [^)]*-(?:done|close)\)/) {
61 # Get Version: pseudo-headers.
63 my ($source, $sourcever, $ver);
64 for ($i = 0; $i < @{$decoded->{body}}; ++$i) {
65 last if $decoded->{body}[$i] !~ /^(\S+):\s*(.*)/;
66 my ($fn, $fv) = (lc $1, $2);
67 if ($fn eq 'source') {
69 } elsif ($fn eq 'source-version' and
70 $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
72 } elsif ($fn eq 'version' and $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
73 # Deal with reportbug brain-damage.
74 next if $fv =~ /^unavailable/i;
77 # Strip off other random junk at the end of a version.
78 $fv =~ s/ *[A-Za-z].*//;
85 push @parsedvers, split /[,\s]+/, $ver;
86 } elsif (defined $source and defined $sourcever) {
87 push @parsedvers, map "$source/$_", split /[,\s]+/, $sourcever;
91 for my $v (@parsedvers) {
92 push @fixed_versions, $v
93 unless exists $fixed_versions{$v};
94 $fixed_versions{$v} = 1;
95 @found_versions = grep { $_ ne $v } @found_versions;
96 delete $found_versions{$v};
99 for my $v (@parsedvers) {
100 push @found_versions, $v
101 unless exists $found_versions{$v};
102 $found_versions{$v} = 1;
103 @fixed_versions = grep { $_ ne $v } @fixed_versions;
104 delete $fixed_versions{$v};
109 # Look for Debian changelogs.
110 for (; $i < @{$decoded->{body}}; ++$i) {
111 if ($decoded->{body}[$i] =~
112 /(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\) \S+; urgency=\S+/i) {
113 my ($p, $v) = ($1, $2);
114 push @fixed_versions, "$p/$v"
115 unless exists $fixed_versions{"$p/$v"};
116 $fixed_versions{"$p/$v"} = 1;
117 @found_versions = grep { $_ ne "$p/$v" } @found_versions;
118 delete $found_versions{"$p/$v"};
125 return (\@found_versions, \@fixed_versions);
130 my ($target, $source) = @_;
131 my %seen = map { $_ => 1 } @$target;
132 for my $v (@$source) {
133 next if exists $seen{$v};
139 my ($db, $verdb) = @ARGV[0, 1];
140 opendir DB, "$gSpoolDir/$db" or die "Can't opendir $db: $!";
142 mkdir $verdb or die "Can't mkdir $verdb: $!";
145 while (defined(my $dir = readdir DB)) {
146 next if $dir =~ /^\.\.?$/ or not -d "$gSpoolDir/$db/$dir";
147 opendir HASH, "$gSpoolDir/$db/$dir"
148 or die "Can't opendir $gSpoolDir/$db/$dir: $!";
150 while (defined(my $file = readdir HASH)) {
151 next unless $file =~ /\.log$/;
152 next if -z "$gSpoolDir/$db/$dir/$file";
153 (my $bug = $file) =~ s/\..*//;
157 # For incremental updates.
158 #next if -e "$verdb/$bughash/$bug.versions" and
159 # (stat "$verdb/$bughash/$bug.versions")[9] >=
160 # (stat "$gSpoolDir/$db/$dir/$file")[9];
162 print "Processing $bug ...\n" if $ENV{DEBBUGS_VERBOSE};
164 my $status = readbug($bug, $db);
165 next unless defined $status;
167 my ($found_versions, $fixed_versions) =
168 getbuginfo("$gSpoolDir/$db/$dir/$file");
170 if (length $status->{mergedwith}) {
171 for my $merge (split ' ', $status->{mergedwith}) {
174 my ($mfound, $mfixed) =
175 getbuginfo("$gSpoolDir/$db/$mergehash/$merge.log");
176 mergeinto($found_versions, $mfound);
177 mergeinto($fixed_versions, $mfixed);
181 @$fixed_versions = () unless length $status->{done};
183 for my $out ($bug, (split ' ', $status->{mergedwith})) {
187 unless (-d "$verdb/$outhash") {
188 mkdir "$verdb/$outhash" or die "Can't mkdir $verdb/$outhash: $!";
191 open VERSIONS, "> $verdb/$outhash/$out.versions"
192 or die "Can't open $verdb/$outhash/$out.versions: $!";
193 print VERSIONS "Found-in: @$found_versions\n";
194 print VERSIONS "Fixed-in: @$fixed_versions\n";