[project @ 2005-07-25 09:18:02 by cjwatson]

[debbugs.git] / scripts / errorlib.in

diff --git a/scripts/errorlib.in b/scripts/errorlib.in
index cdf18557e7db8176727517be3bc442c600900627..78ee2abaddf240d258c72b6fc46e96f1896cb852 100755 (executable)
--- a/scripts/errorlib.in
+++ b/scripts/errorlib.in
@@ -1,8 +1,9 @@
 # -*- perl -*-
-# $Id: errorlib.in,v 1.42 2005/04/09 16:21:02 cjwatson Exp $
+# $Id: errorlib.in,v 1.48 2005/07/24 17:39:09 cjwatson Exp $
 
 use Mail::Address;
 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
+use Debbugs::Packages;
 
 sub F_SETLK { 6; } sub F_WRLCK{ 1; }
 $flockstruct= 'sslll'; # And there ought to be something for this too.
@@ -22,7 +23,7 @@ sub lockreadbugmerge {
     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 ); }
@@ -85,6 +86,8 @@ my %fields = (originator => 'submitter',
               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.
@@ -123,7 +126,9 @@ sub readbug {
 
     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) {
@@ -147,6 +152,9 @@ sub makestatus {
     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;
@@ -254,6 +262,102 @@ sub unfilelock {
     unlink($lockfile) || warn "failed to remove lock file $lockfile: $!";
 }
 
+sub addfoundversions {
+    my $data = shift;
+    my $package = shift;
+    my $version = shift;
+    my $isbinary = shift;
+    return unless defined $version;
+    undef $package if $package =~ m[(?:\s|/)];
+    my $source = $package;
+
+    if (defined $package and $isbinary) {
+        my @srcinfo = binarytosource($package, $version, undef);
+        if (@srcinfo) {
+            # We know the source package(s). Use a fully-qualified version.
+            addfoundversions($data, $_->[0], $_->[1], '') foreach @srcinfo;
+            return;
+        }
+        # Otherwise, an unqualified version will have to do.
+    }
+
+    # Strip off various kinds of brain-damage.
+    $version =~ s/;.*//;
+    $version =~ s/ *\(.*\)//;
+    $version =~ s/ +[A-Za-z].*//;
+
+    foreach my $ver (split /[,\s]+/, $version) {
+        my $sver = defined($source) ? "$source/$ver" : '';
+        unless (grep { $_ eq $ver or $_ eq $sver } @{$data->{found_versions}}) {
+            push @{$data->{found_versions}}, defined($source) ? $sver : $ver;
+        }
+        @{$data->{fixed_versions}} =
+            grep { $_ ne $ver and $_ ne $sver } @{$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) {
+        my $sver = defined($source) ? "$source/$ver" : '';
+        @{$data->{found_versions}} =
+            grep { $_ ne $ver and $_ ne $sver } @{$data->{found_versions}};
+    }
+}
+
+sub addfixedversions {
+    my $data = shift;
+    my $package = shift;
+    my $version = shift;
+    my $isbinary = shift;
+    return unless defined $version;
+    undef $package if $package =~ m[(?:\s|/)];
+    my $source = $package;
+
+    if (defined $package and $isbinary) {
+        my @srcinfo = binarytosource($package, $version, undef);
+        if (@srcinfo) {
+            # We know the source package(s). Use a fully-qualified version.
+            addfixedversions($data, $_->[0], $_->[1], '') foreach @srcinfo;
+            return;
+        }
+        # Otherwise, an unqualified version will have to do.
+    }
+
+    # Strip off various kinds of brain-damage.
+    $version =~ s/;.*//;
+    $version =~ s/ *\(.*\)//;
+    $version =~ s/ +[A-Za-z].*//;
+
+    foreach my $ver (split /[,\s]+/, $version) {
+        my $sver = defined($source) ? "$source/$ver" : '';
+        unless (grep { $_ eq $ver or $_ eq $sver } @{$data->{fixed_versions}}) {
+            push @{$data->{fixed_versions}}, defined($source) ? $sver : $ver;
+        }
+        @{$data->{found_versions}} =
+            grep { $_ ne $ver and $_ ne $sver } @{$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) {
+        my $sver = defined($source) ? "$source/$ver" : '';
+        @{$data->{fixed_versions}} =
+            grep { $_ ne $ver and $_ ne $sver } @{$data->{fixed_versions}};
+    }
+}
+
 sub quit {
     print DEBUG "quitting >$_[0]<\n";
     local ($u);