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 # <@aj> Hackin' on the BTS, Feelin' like it'll take forever; Oh you better
7 # hold it's hand, when it dies on names so clever. These are the best
8 # bugs of our life. It's up to archive-slash-69, man we were killin'
9 # time, we were young and resltess, we needed to unwind. I guess
10 # nothin' can last forever - forever, no...
12 my $config_path = '/etc/debbugs';
13 my $lib_path = '/usr/lib/debbugs';
15 require "$config_path/config";
16 require "$lib_path/errorlib";
33 open LOG, "< $log" or die "Can't open $log: $!";
34 my @records = read_log_records(*LOG);
37 my (@found_versions, @fixed_versions);
38 my (%found_versions, %fixed_versions);
40 for my $record (@records) {
41 if ($record->{type} eq 'html') {
42 # Reassigns zap the found and fixed version list. Reopens will
43 # zap the fixed list too in the full deployment, but doing that
44 # here causes problems in case of accidental reopens and
46 if ($record->{text} =~ /assigned/) {
55 next unless $record->{type} eq 'autocheck' or
56 $record->{type} eq 'incoming-recv';
57 my $decoded = Debbugs::MIME::parse($record->{text});
58 next unless defined $decoded;
60 # Was it sent to -done or -close?
62 my $firstreceived = $decoded->{header}[0];
63 if ($firstreceived =~ /\(at [^)]*-(?:done|close)\)/) {
67 # Get Version: pseudo-headers.
69 my ($source, $sourcever, $ver);
70 for ($i = 0; $i < @{$decoded->{body}}; ++$i) {
71 last if $decoded->{body}[$i] !~ /^(\S+):\s*(.*)/;
72 my ($fn, $fv) = (lc $1, $2);
73 if ($fn eq 'source') {
75 } elsif ($fn eq 'source-version' and
76 $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
78 } elsif ($fn eq 'version' and $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
79 # Deal with reportbug brain-damage.
80 next if $fv =~ /^unavailable/i;
83 # Strip off other random junk at the end of a version.
84 $fv =~ s/ +[A-Za-z].*//;
91 push @parsedvers, split /[,\s]+/, $ver;
92 } elsif (defined $source and defined $sourcever) {
93 push @parsedvers, map "$source/$_", split /[,\s]+/, $sourcever;
97 for my $v (@parsedvers) {
98 push @fixed_versions, $v
99 unless exists $fixed_versions{$v};
100 $fixed_versions{$v} = 1;
101 @found_versions = grep { $_ ne $v } @found_versions;
102 delete $found_versions{$v};
105 for my $v (@parsedvers) {
106 push @found_versions, $v
107 unless exists $found_versions{$v};
108 $found_versions{$v} = 1;
109 @fixed_versions = grep { $_ ne $v } @fixed_versions;
110 delete $fixed_versions{$v};
115 # Look for Debian changelogs.
116 for (; $i < @{$decoded->{body}}; ++$i) {
117 if ($decoded->{body}[$i] =~
118 /(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\) \S+; urgency=\S+/i) {
119 my ($p, $v) = ($1, $2);
120 push @fixed_versions, "$p/$v"
121 unless exists $fixed_versions{"$p/$v"};
122 $fixed_versions{"$p/$v"} = 1;
123 @found_versions = grep { $_ ne "$p/$v" } @found_versions;
124 delete $found_versions{"$p/$v"};
131 return (\@found_versions, \@fixed_versions);
136 my ($target, $source) = @_;
137 my %seen = map { $_ => 1 } @$target;
138 for my $v (@$source) {
139 next if exists $seen{$v};
145 chdir $gSpoolDir or die "Can't chdir $gSpoolDir: $!";
148 opendir DB, $db or die "Can't opendir $db: $!";
150 while (defined(my $dir = readdir DB)) {
151 next if $dir =~ /^\.\.?$/ or not -d "$db/$dir";
152 opendir HASH, "$db/$dir" or die "Can't opendir $db/$dir: $!";
154 while (defined(my $file = readdir HASH)) {
155 next unless $file =~ /\.log$/;
156 next if -z "$db/$dir/$file";
157 (my $bug = $file) =~ s/\..*//;
162 print "Processing $bug ...\n" if $ENV{DEBBUGS_VERBOSE};
164 my ($locks, $status) = lockreadbugmerge($bug, $db);
165 unless (defined $status) {
166 unlockreadbugmerge($locks);
170 if (@{$status->{found_versions}} or @{$status->{fixed_versions}}) {
171 unlockreadbugmerge($locks);
176 # Only process the lowest of each set of merged bugs.
177 if (length $status->{mergedwith}) {
178 @merges = sort { $a <=> $b } split ' ', $status->{mergedwith};
179 if ($merges[0] < $bug) {
180 unlockreadbugmerge($locks);
185 my ($found_versions, $fixed_versions) = getbuginfo("$db/$dir/$file");
187 if (length $status->{mergedwith}) {
188 for my $merge (@merges) {
191 my ($mfound, $mfixed) =
192 getbuginfo("$db/$mergehash/$merge.log");
193 mergeinto($found_versions, $mfound);
194 mergeinto($fixed_versions, $mfixed);
198 @$fixed_versions = () unless length $status->{done};
200 for my $out ($bug, @merges) {
202 filelock("lock/$out");
204 my $outstatus = readbug($out, $db);
205 $outstatus->{found_versions} = [@$found_versions];
206 $outstatus->{fixed_versions} = [@$fixed_versions];
207 writebug($out, $outstatus, $db, 2, 'disable bughook');
213 unlockreadbugmerge($locks);