# -*- perl -*-
-# $Id: errorlib.in,v 1.38 2003/08/23 15:12:57 cjwatson Exp $
+# $Id: errorlib.in,v 1.46 2005/07/18 03:09:09 cjwatson Exp $
use Mail::Address;
+use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
sub F_SETLK { 6; } sub F_WRLCK{ 1; }
$flockstruct= 'sslll'; # And there ought to be something for this too.
local ($lref, $location) = @_;
local $data;
if (!($data = &lockreadbug($lref, $location))) { return ( 0, undef ); }
- if (!length($data{mergedwith})) { return ( 1, $data ); }
+ if (!length($data->{mergedwith})) { return ( 1, $data ); }
&unfilelock;
&filelock('lock/merge');
if (!&lockreadbug($lref, $location)) { &unfilelock; return ( 0, undef ); }
forwarded => 'forwarded-to',
mergedwith => 'merged-with',
severity => 'severity',
+ owner => 'owner',
+ found_versions => 'found-in',
+ fixed_versions => 'fixed-in',
);
+# Fields which need to be RFC1522-decoded in format versions earlier than 3.
+my @rfc1522_fields = qw(originator subject done forwarded owner);
+
sub readbug {
my ($lref, $location) = @_;
my $status = getbugcomponent($lref, 'summary', $location);
while (<S>) {
chomp;
push @lines, $_;
- $version = $1 if /^Format-Version: (.*)/i;
+ $version = $1 if /^Format-Version: ([0-9]+)/i;
}
- # Version 2 is the latest format version currently supported.
- return undef if $version > 2;
+ # Version 3 is the latest format version currently supported.
+ return undef if $version > 3;
my %namemap = reverse %fields;
for my $line (@lines) {
close(S);
- $data{severity} = 'normal' if $data{severity} eq '';
+ $data{severity} = $gDefaultSeverity if $data{severity} eq '';
+ $data{found_versions} = [split ' ', $data{found_versions}];
+ $data{fixed_versions} = [split ' ', $data{fixed_versions}];
+
+ if ($version < 3) {
+ for my $field (@rfc1522_fields) {
+ $data{$field} = decode_rfc1522($data{$field});
+ }
+ }
return \%data;
}
my $version = shift;
$version = 2 unless defined $version;
+ local $data->{found_versions} = join ' ', @{$data->{found_versions}};
+ local $data->{fixed_versions} = join ' ', @{$data->{fixed_versions}};
+
my $contents = '';
+ my %newdata = %$data;
+ if ($version < 3) {
+ for my $field (@rfc1522_fields) {
+ $newdata{$field} = encode_rfc1522($newdata{$field});
+ }
+ }
+
if ($version == 1) {
for my $field (@v1fieldorder) {
- if (exists $data->{$field}) {
- $contents .= "$data->{$field}\n";
+ if (exists $newdata{$field}) {
+ $contents .= "$newdata{$field}\n";
} else {
$contents .= "\n";
}
}
- } elsif ($version == 2) {
- # Version 2. Add a file format version number for the sake of
+ } elsif ($version == 2 or $version == 3) {
+ # Version 2 or 3. Add a file format version number for the sake of
# further extensibility in the future.
- $contents .= "Format-Version: 2\n";
+ $contents .= "Format-Version: $version\n";
for my $field (keys %fields) {
- if (exists $data->{$field} and $data->{$field} ne '') {
+ if (exists $newdata{$field} and $newdata{$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";
+ $contents .= "$properfield: $newdata{$field}\n";
}
}
}
unlink($lockfile) || warn "failed to remove lock file $lockfile: $!";
}
+sub addfoundversions {
+ my $data = shift;
+ my $source = shift;
+ my $version = shift;
+ return unless defined $version;
+ undef $source if $source =~ m[(?:\s|/)];
+
+ # Strip off various kinds of brain-damage.
+ $version =~ s/;.*//;
+ $version =~ s/ *\(.*\)//;
+ $version =~ s/ +[A-Za-z].*//;
+
+ foreach my $ver (split /[,\s]+/, $version) {
+ $ver = "$source/$ver" if defined $source;
+ unless (grep { $_ eq $ver } @{$data->{found_versions}}) {
+ push @{$data->{found_versions}}, $ver;
+ }
+ @{$data->{fixed_versions}} =
+ grep { $_ ne $ver } @{$data->{fixed_versions}};
+ }
+}
+
+sub removefoundversions {
+ my $data = shift;
+ my $source = shift;
+ my $version = shift;
+ return unless defined $version;
+ undef $source if $source =~ m[(?:\s|/)];
+
+ foreach my $ver (split /[,\s]+/, $version) {
+ $ver = "$source/$ver" if defined $source;
+ @{$data->{found_versions}} =
+ grep { $_ ne $ver } @{$data->{found_versions}};
+ }
+}
+
+sub addfixedversions {
+ my $data = shift;
+ my $source = shift;
+ my $version = shift;
+ return unless defined $version;
+ undef $source if $source =~ m[(?:\s|/)];
+
+ # Strip off various kinds of brain-damage.
+ $version =~ s/;.*//;
+ $version =~ s/ *\(.*\)//;
+ $version =~ s/ +[A-Za-z].*//;
+
+ foreach my $ver (split /[,\s]+/, $version) {
+ $ver = "$source/$ver" if defined $source;
+ unless (grep { $_ eq $ver } @{$data->{fixed_versions}}) {
+ push @{$data->{fixed_versions}}, $ver;
+ }
+ @{$data->{found_versions}} =
+ grep { $_ ne $ver } @{$data->{found_versions}};
+ }
+}
+
+sub removefixedversions {
+ my $data = shift;
+ my $source = shift;
+ my $version = shift;
+ return unless defined $version;
+ undef $source if $source =~ m[(?:\s|/)];
+
+ foreach my $ver (split /[,\s]+/, $version) {
+ $ver = "$source/$ver" if defined $source;
+ @{$data->{fixed_versions}} =
+ grep { $_ ne $ver } @{$data->{fixed_versions}};
+ }
+}
+
sub quit {
print DEBUG "quitting >$_[0]<\n";
local ($u);
sub getmailbody {
my $entity = shift;
my $type = $entity->effective_type;
- if ($type eq 'text/plain' or
- ($type =~ m#text/# and $type ne 'text/html') or
+ if ($type =~ m#text/(?!html|enriched)# or
$type eq 'application/pgp') {
return $entity->bodyhandle;
} elsif ($type eq 'multipart/alternative') {