# guesswork, based on Version: pseudo-headers and closing mails that look
# like Debian changelogs. The latter in particular is somewhat heuristic.
-use strict;
+my $config_path = '/etc/debbugs';
+my $lib_path = '/usr/lib/debbugs';
+
+require "$config_path/config";
+require "$lib_path/errorlib";
+
use Debbugs::Log;
use Debbugs::MIME;
if (@ARGV != 2) {
print <<EOF;
-Usage: $0 db-directory versions-directory
+Usage: $0 db-type 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);
# Get Version: pseudo-headers.
my $i;
+ my ($source, $sourcever, $ver);
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 ($fn eq 'source') {
+ $source = $fv;
+ } elsif ($fn eq 'source-version' and
+ $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
+ $sourcever = $fv;
+ } elsif ($fn eq 'version' and $fv =~ /^(\d[^,\s]*(?:[,\s]+|$))+/) {
+ # Deal with reportbug brain-damage.
+ next if $fv =~ /^unavailable/i;
+ $fv =~ s/;.*//;
+ $fv =~ s/ *\(.*\)//;
+ # Strip off other random junk at the end of a version.
+ $fv =~ s/ *[A-Za-z].*//;
+ $ver = $fv;
+ }
+ }
+
+ my @parsedvers;
+ if (defined $ver) {
+ push @parsedvers, split /[,\s]+/, $ver;
+ } elsif (defined $source and defined $sourcever) {
+ push @parsedvers, map "$source/$_", split /[,\s]+/, $sourcever;
+ }
+
+ if ($closing) {
+ for my $v (@parsedvers) {
+ 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 (@parsedvers) {
+ push @found_versions, $v
+ unless exists $found_versions{$v};
+ $found_versions{$v} = 1;
+ @fixed_versions = grep { $_ ne $v } @fixed_versions;
+ delete $fixed_versions{$v};
}
}
# 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};
+ /(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\) \S+; urgency=\S+/i) {
+ my ($p, $v) = ($1, $2);
+ push @fixed_versions, "$p/$v"
+ unless exists $fixed_versions{"$p/$v"};
+ $fixed_versions{"$p/$v"} = 1;
+ @found_versions = grep { $_ ne "$p/$v" } @found_versions;
+ delete $found_versions{"$p/$v"};
last;
}
}
}
my ($db, $verdb) = @ARGV[0, 1];
-opendir DB, $db or die "Can't opendir $db: $!";
+opendir DB, "$gSpoolDir/$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: $!";
+ next if $dir =~ /^\.\.?$/ or not -d "$gSpoolDir/$db/$dir";
+ opendir HASH, "$gSpoolDir/$db/$dir"
+ or die "Can't opendir $gSpoolDir/$db/$dir: $!";
while (defined(my $file = readdir HASH)) {
next unless $file =~ /\.log$/;
- next if -z "$db/$dir/$file";
+ next if -z "$gSpoolDir/$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];
+ # For incremental updates.
+ #next if -e "$verdb/$bughash/$bug.versions" and
+ # (stat "$verdb/$bughash/$bug.versions")[9] >=
+ # (stat "$gSpoolDir/$db/$dir/$file")[9];
+
+ print "Processing $bug ...\n" if $ENV{DEBBUGS_VERBOSE};
- 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 $status = readbug($bug, $db);
+ next unless defined $status;
- my ($found_versions, $fixed_versions) = getbuginfo("$db/$dir/$file");
+ my ($found_versions, $fixed_versions) =
+ getbuginfo("$gSpoolDir/$db/$dir/$file");
- if (length $mergedwith) {
- for my $merge (split ' ', $mergedwith) {
+ if (length $status->{mergedwith}) {
+ for my $merge (split ' ', $status->{mergedwith}) {
$merge =~ /(..)$/;
my $mergehash = $1;
my ($mfound, $mfixed) =
- getbuginfo("$db/$mergehash/$merge.log");
+ getbuginfo("$gSpoolDir/$db/$mergehash/$merge.log");
mergeinto($found_versions, $mfound);
mergeinto($fixed_versions, $mfixed);
}
}
- @$fixed_versions = () unless length $done;
+ @$fixed_versions = () unless length $status->{done};
- for my $out ($bug, (split ' ', $mergedwith)) {
+ for my $out ($bug, (split ' ', $status->{mergedwith})) {
$out =~ /(..)$/;
my $outhash = $1;
projects / debbugs.git / blobdiff