Implement .status format version 2.
The new format is RFC822-style (continuation lines not implemented, but
feel free to do so), and it's stored in .db files alongside .status, to
make migration less of a one-way affair. Field names are more or less those
used internally, with a few slight changes (originator => submitter, msgid
=> message-id, keywords => tags, forwarded => forwarded-to, mergedwith =>
merged-with). A Format-Version: field is included (currently always 2) to
make the guts of the format extensible in the future should anyone wish to
do so. New fields, though, may be added without incrementing the
format-version, which is the main point of this change.
Support for reading the old format (henceforth "version 1") has been
removed, per Adam Heath. A new migration tool, debbugs-upgradestatus, is
provided, and must be run after upgrading to this version and before
turning debbugs back on.
I think I've changed everything that referred to .status files. We'll find
out once bugs.debian.org has been running this for a while ...
There is precious little documentation of any of this yet.
my %status;
- my $location = getbuglocation( $bugnum, "status" );
+ my $location = getbuglocation( $bugnum, 'db' );
return {} if ( !$location );
%status = %{ readbug( $bugnum, $location ) };
--- /dev/null
+#! /usr/bin/perl -w
+# Migrate from .status format version 1 to version 2. The new format uses
+# RFC822-style name/value pairs to allow new fields to be added more easily.
+
+use vars qw($gSpoolDir);
+
+my $config_path = '/etc/debbugs';
+my $lib_path = '/usr/lib/debbugs';
+
+require "$config_path/config";
+require "$lib_path/errorlib";
+
+if (@ARGV < 1 or $ARGV[0] !~ /^(?:db-h|archive)$/) {
+ print <<EOF;
+Usage: $0 db-h|archive (relative to $gSpoolDir)
+
+debbugs-upgradestatus converts a debbugs database in-place to use version 2
+of the bug status file format. Version 1 metadata files were stored in
+.status files; version 2 metadata files are written to .db files.
+
+EOF
+ exit 0;
+}
+
+chdir $gSpoolDir or die "Can't chdir to $gSpoolDir: $!";
+
+my $archive = $ARGV[0];
+my $db = getlocationpath($archive);
+opendir DB, $db or die "Can't opendir $db: $!";
+
+my @files;
+for (my $subdir = 0; $subdir < 100; ++$subdir) {
+ my $path = sprintf "$archive/%.2d", $subdir;
+ opendir DIR, $path or next;
+ my @list = grep /^\d+\.status$/, readdir DIR;
+ closedir DIR;
+ grep s/\.status$//, @list;
+ push @files, @list;
+}
+
+closedir DB;
+
+@files = sort { $a <=> $b } @files;
+
+my @v1fields = qw(originator date subject msgid package
+ keywords done forwarded mergedwith severity);
+
+sub v1readbug {
+ my ($lref, $location) = @_;
+ my $status = getbugcomponent($lref, 'status', $location);
+ return undef unless defined $status;
+ if (!open(S,$status)) { return undef; }
+
+ my %data;
+ my @lines;
+ local $_;
+
+ while (<S>) {
+ chomp;
+ push @lines, $_;
+ }
+
+ for my $field (@v1fields) {
+ if (@lines) {
+ $data{$field} = shift @lines;
+ } else {
+ $data{$field} = '';
+ }
+ }
+
+ close(S);
+
+ $data{severity} = 'normal' if $data{severity} eq '';
+
+ return \%data;
+}
+
+my $success = 0;
+my $failure = 0;
+for my $ref (@files) {
+ filelock("lock/$ref") unless $ENV{NO_LOCKING};
+ my $data = v1readbug($ref, $archive);
+ if (defined $data) {
+ if ($ENV{NO_LOCKING}) {
+ writebug($ref, $data, $archive, 2, 'disable bughook');
+ } else {
+ unlockwritebug($ref, $data, $archive, 2, 'disable bughook');
+ }
+
+ # Test new .db file
+ my $newdata = readbug($ref, $archive);
+ my %jointkeys = map { $_ => 1 } (keys %$data), (keys %$newdata);
+ for my $key (keys %jointkeys) {
+ unless (exists $data->{$key}) {
+ die "BUG: $ref: key '$key' in .db but not .status!\n";
+ }
+ unless (exists $newdata->{$key}) {
+ die "BUG: $ref: key '$key' in .status but not .db!\n";
+ }
+ if ($data->{$key} ne $newdata->{$key}) {
+ die "BUG: $ref: key '$key' different in .status and .db:\n" .
+ " .status has '$data->{$key}';\n" .
+ " .db has '$newdata->{$key}'!\n";
+ }
+ }
+
+ ++$success;
+ } else {
+ unfilelock() unless $ENV{NO_LOCKING};
+ ++$failure;
+ }
+}
+
+print "$success bugs converted successfully.\n" if $success;
+print "Failed to convert $failure bugs.\n" if $failure;
+
+exit !($success && !$failure);
# -*- perl -*-
-# $Id: errorlib.in,v 1.34 2003/08/21 19:21:43 cjwatson Exp $
+# $Id: errorlib.in,v 1.35 2003/08/22 01:41:54 cjwatson Exp $
use Mail::Address;
}
}
-my @fields = qw(originator date subject msgid package
- keywords done forwarded mergedwith severity);
+my @v1fieldorder = qw(originator date subject msgid package
+ keywords done forwarded mergedwith severity);
+
+my %fields = (originator => 'submitter',
+ date => 'date',
+ subject => 'subject',
+ msgid => 'message-id',
+ 'package' => 'package',
+ keywords => 'tags',
+ done => 'done',
+ forwarded => 'forwarded-to',
+ mergedwith => 'merged-with',
+ severity => 'severity',
+ );
sub readbug {
- local ($lref, $location) = @_;
- my $status = getbugcomponent($lref, 'status', $location);
+ my ($lref, $location) = @_;
+ my $status = getbugcomponent($lref, 'db', $location);
return undef unless defined $status;
if (!open(S,$status)) { return undef; }
my %data;
my @lines;
+ my $version = 2;
local $_;
while (<S>) {
chomp;
push @lines, $_;
+ $version = $1 if /^Format-Version: (.*)/i;
}
- for my $field (@fields) {
- if (@lines) {
- $data{$field} = shift @lines;
- } else {
- $data{$field} = '';
+ # Version 2 is the latest format version currently supported.
+ return undef if $version > 2;
+
+ my %namemap = reverse %fields;
+ for my $line (@lines) {
+ if ($line =~ /(\S+?): (.*)/) {
+ my ($name, $value) = (lc $1, $2);
+ $data{$namemap{$name}} = $value if exists $namemap{$name};
}
}
+ for my $field (keys %fields) {
+ $data{$field} = '' unless exists $data{$field};
+ }
close(S);
sub makestatus {
my $data = shift;
+ my $version = shift;
+ $version = 2 unless defined $version;
+
my $contents = '';
- for my $field (@fields) {
- if (exists $data->{$field}) {
- $contents .= "$data->{$field}\n";
- } else {
- $contents .= "\n";
+ if ($version == 1) {
+ for my $field (@v1fieldorder) {
+ if (exists $data->{$field}) {
+ $contents .= "$data->{$field}\n";
+ } else {
+ $contents .= "\n";
+ }
+ }
+ } elsif ($version == 2) {
+ # Version 2. Add a file format version number for the sake of
+ # further extensibility in the future.
+ $contents .= "Format-Version: 2\n";
+ for my $field (keys %fields) {
+ if (exists $data->{$field} and $data->{$field} ne '') {
+ # Output field names in proper case, e.g. 'Merged-With'.
+ my $properfield = $fields{$field};
+ $properfield =~ s/(?:^|(?<=-))([a-z])/\u$1/g;
+ $contents .= "$properfield: $data->{$field}\n";
+ }
}
}
}
sub writebug {
- local ($ref, $data, $location) = @_;
+ my ($ref, $data, $location, $minversion, $disablebughook) = @_;
my $change;
- my $status = getbugcomponent($ref, 'status', $location);
- &quit("can't find location for $ref") unless defined $status;
- open(S,"> $status.new") || &quit("opening $status.new: $!");
- print(S makestatus($data)) || &quit("writing $status.new: $!");
- close(S) || &quit("closing $status.new: $!");
- if (-e $status) {
- $change = 'change';
- } else {
- $change = 'new';
+
+ my %outputs = (1 => 'status', 2 => 'db');
+ for my $version (keys %outputs) {
+ next if defined $minversion and $version < $minversion;
+ my $status = getbugcomponent($ref, $outputs{$version}, $location);
+ &quit("can't find location for $ref") unless defined $status;
+ open(S,"> $status.new") || &quit("opening $status.new: $!");
+ print(S makestatus($data, $version)) ||
+ &quit("writing $status.new: $!");
+ close(S) || &quit("closing $status.new: $!");
+ if (-e $status) {
+ $change = 'change';
+ } else {
+ $change = 'new';
+ }
+ rename("$status.new",$status) || &quit("installing new $status: $!");
}
- rename("$status.new",$status) || &quit("installing new $status: $!");
- &bughook($change,$ref,$data);
+
+ # $disablebughook is a bit of a hack to let format migration scripts use
+ # this function rather than having to duplicate it themselves.
+ &bughook($change,$ref,$data) unless $disablebughook;
}
sub unlockwritebug {
my ( $type, $ref, $data ) = @_;
&filelock("debbugs.trace.lock");
- &appendfile("debbugs.trace","$type $ref\n",makestatus($data));
+ &appendfile("debbugs.trace","$type $ref\n",makestatus($data, 1));
my $whendone = "open";
my $severity = $gDefaultSeverity;
#!/usr/bin/perl
-# $Id: expire.in,v 1.17 2003/08/06 10:57:23 cjwatson Exp $
+# $Id: expire.in,v 1.18 2003/08/22 01:41:54 cjwatson Exp $
# Load modules and set envirnment
use File::Copy;
close(DIR);
foreach my $dir (@dirs) {
opendir(DIR,$dir);
- push @list, sort { $a <=> $b } grep(s/\.status$//,grep(m/^\d+\.status$/,readdir(DIR)));
+ push @list, sort { $a <=> $b } grep(s/\.db$//,grep(m/^\d+\.db$/,readdir(DIR)));
close(DIR);
}
`mkdir -p "archive/$dir"`;
link( "db-h/$dir/$mref.log", "archive/$dir/$mref.log" ) || copy( "db-h/$dir/$mref.log", "archive/$dir/$mref.log" );
link( "db-h/$dir/$mref.status", "archive/$dir/$mref.status" ) || copy( "db-h/$dir/$mref.status", "archive/$dir/$mref.status" );
+ link( "db-h/$dir/$mref.db", "archive/$dir/$mref.db" ) || copy( "db-h/$dir/$mref.db", "archive/$dir/$mref.db" );
link( "db-h/$dir/$mref.report", "archive/$dir/$mref.report" ) || copy( "db-h/$dir/$mref.report", "archive/$dir/$mref.report" );
print("archived $mref to archive/$dir (from $ref)\n") || &quit("output old: $!");
}
- unlink("db-h/$dir/$mref.log", "db-h/$dir/$mref.status", "db-h/$dir/$mref.report");
+ unlink("db-h/$dir/$mref.log", "db-h/$dir/$mref.status", "db-h/$dir/$mref.db", "db-h/$dir/$mref.report");
print("deleted $mref (from $ref)\n") || &quit("output old: $!");
bughook_archive($mref);
}
#!/usr/bin/perl -w
-# $Id: rebuild.in,v 1.11 2003/05/31 13:41:39 cjwatson Exp $
+# $Id: rebuild.in,v 1.12 2003/08/22 01:41:54 cjwatson Exp $
# Load modules and set environment
use File::Copy;
{
my $path = sprintf( "$archive/%.2d", $subdir );
opendir(DIR,$path) || next;
- my @list= grep(m/^\d+\.status$/,readdir(DIR));
+ my @list= grep(m/^\d+\.db$/,readdir(DIR));
closedir DIR;
- grep(s/\.status$//,@list);
+ grep(s/\.db$//,@list);
push @files, @list;
}
#!/usr/bin/perl
-# $Id: service.in,v 1.85 2003/08/20 23:33:54 cjwatson Exp $
+# $Id: service.in,v 1.86 2003/08/22 01:41:54 cjwatson Exp $
#
# Usage: service <code>.nn
# Temps: incoming/P<code>.nn
my $hash = get_hashname($ref);
copy("db-h/$ohash/$origref.log", "db-h/$hash/$ref.log");
copy("db-h/$ohash/$origref.status", "db-h/$hash/$ref.status");
+ copy("db-h/$ohash/$origref.db", "db-h/$hash/$ref.db");
copy("db-h/$ohash/$origref.report", "db-h/$hash/$ref.report");
&bughook('new', $ref, $data);
#!/usr/bin/perl
-# $Id: summary.in,v 1.8 2003/05/03 20:01:20 doogie Exp $
+# $Id: summary.in,v 1.9 2003/08/22 01:41:54 cjwatson Exp $
$config_path = '/etc/debbugs';
$lib_path = '/usr/lib/debbugs';
closedir(DIR);
foreach my $dir (@dirs) {
opendir(DIR,$dir);
- push @list, sort { $a <=> $b } grep(s/\.status$//,grep(m/^\d+\.status$/,readdir(DIR)));
+ push @list, sort { $a <=> $b } grep(s/\.db$//,grep(m/^\d+\.db$/,readdir(DIR)));
closedir(DIR);
}