]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Status.pm
fix incorrect lexical variables in Debbugs
[debbugs.git] / Debbugs / Status.pm
index c28dd08f91755841ebc9549d0a40476e3503c982..0cc0af9a59a4ad743af6b8951f4a66074a1689d4 100644 (file)
@@ -28,10 +28,10 @@ use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
 use base qw(Exporter);
 
 use Params::Validate qw(validate_with :types);
-use Debbugs::Common qw(:util :lock);
+use Debbugs::Common qw(:util :lock :quit :misc);
 use Debbugs::Config qw(:config);
 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
-use Debbugs::Packages qw(makesourceversions getversions);
+use Debbugs::Packages qw(makesourceversions getversions binarytosource);
 use Debbugs::Versions;
 use Debbugs::Versions::Dpkg;
 use POSIX qw(ceil);
@@ -43,16 +43,17 @@ BEGIN{
 
      @EXPORT = ();
      %EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable),
-                               qw(isstrongseverity),
+                               qw(isstrongseverity bug_presence),
                               ],
                     read   => [qw(readbug read_bug lockreadbug)],
                     write  => [qw(writebug makestatus unlockwritebug)],
-                    versions => [qw(addfoundversion addfixedversion),
-                                 qw(removefoundversions)
+                    versions => [qw(addfoundversions addfixedversions),
+                                 qw(removefoundversions removefixedversions)
                                 ],
+                    hook     => [qw(bughook bughook_archive)],
                    );
      @EXPORT_OK = ();
-     Exporter::export_ok_tags(qw(status read write versions));
+     Exporter::export_ok_tags(qw(status read write versions hook));
      $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
@@ -131,9 +132,12 @@ sub read_bug{
     my %param = validate_with(params => \@_,
                              spec   => {bug => {type => SCALAR,
                                                 optional => 1,
-                                                regex    => qr/^\d+/,
+                                                # something really
+                                                # stupid passes
+                                                # negative bugnumbers
+                                                regex    => qr/^-?\d+/,
                                                },
-                                        location => {type => SCALAR,
+                                        location => {type => SCALAR|UNDEF,
                                                      optional => 1,
                                                     },
                                         summary  => {type => SCALAR,
@@ -189,6 +193,8 @@ sub read_bug{
         $data{$field} = [split ' ', $data{$field}];
     }
     for my $field (qw(found fixed)) {
+        # create the found/fixed hashes which indicate when a
+        # particular version was marked found or marked fixed.
         @{$data{$field}}{@{$data{"${field}_versions"}}} =
              (('') x (@{$data{"${field}_date"}} - @{$data{"${field}_versions"}}),
               @{$data{"${field}_date"}});
@@ -257,7 +263,7 @@ sub makestatus {
     }
 
     for my $field (qw(found_versions fixed_versions found_date fixed_date)) {
-        $newdata{$field} = [split ' ', $newdata{$field}];
+        $newdata{$field} = join ' ', @{$newdata{$field}||[]};
     }
 
     if ($version < 3) {
@@ -268,7 +274,7 @@ sub makestatus {
 
     if ($version == 1) {
         for my $field (@v1fieldorder) {
-            if (exists $newdata{$field}) {
+            if (exists $newdata{$field} and defined $newdata{$field}) {
                 $contents .= "$newdata{$field}\n";
             } else {
                 $contents .= "\n";
@@ -279,7 +285,8 @@ sub makestatus {
         # further extensibility in the future.
         $contents .= "Format-Version: $version\n";
         for my $field (keys %fields) {
-            if (exists $newdata{$field} and $newdata{$field} ne '') {
+            if (exists $newdata{$field} and defined $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;
@@ -436,7 +443,7 @@ sub addfixedversions {
     my $version = shift;
     my $isbinary = shift;
     return unless defined $version;
-    undef $package if $package =~ m[(?:\s|/)];
+    undef $package if defined $package and $package =~ m[(?:\s|/)];
     my $source = $package;
 
     if (defined $package and $isbinary) {
@@ -539,7 +546,7 @@ Returns undef on failure.
 =cut
 
 # This will eventually need to be fixed before we start using mod_perl
-my $version_cache = {};
+our $version_cache = {};
 sub bug_archiveable{
      my %param = validate_with(params => \@_,
                               spec   => {bug => {type => SCALAR,
@@ -572,41 +579,45 @@ sub bug_archiveable{
          return $cannot_archive;
      }
      # At this point, we have to get the versioning information for this bug.
-
      # We examine the set of distribution tags. If a bug has no distribution
      # tags set, we assume a default set, otherwise we use the tags the bug
      # has set.
-     my %dist_tags;
-     @dist_tags{@{$config{removal_distribution_tags}}} =
-         (1) x @{$config{removal_distribution_tags}};
-     my %dists;
-     @dists{@{$config{removal_default_distribution_tags}}} = 
-         (1) x @{$config{removal_default_distribution_tags}};
-     for my $tag (split ' ', $status->{tags}) {
-         next unless $dist_tags{$tag};
-         $dists{$tag} = 1;
-     }
-     my %source_versions;
-     for my $dist (keys %dists){
-         my @versions;
-         @versions = getversions($status->{package},
-                                 $dist,
-                                 undef);
-         # TODO: This should probably be handled further out for efficiency and
-         # for more ease of distinguishing between pkg= and src= queries.
-         my @sourceversions = makesourceversions($status->{package},
-                                                 $dist,
-                                                 @versions);
-         @source_versions{@sourceversions} = (1) x @sourceversions;
-     }
-     if ('found' eq max_buggy(bug => $param{bug},
-                             sourceversions => [keys %source_versions],
-                             found          => $status->{found_versions},
-                             fixed          => $status->{fixed_versions},
-                             version_cache  => $version_cache,
-                             package        => $status->{package},
-                            )) {
-         return $cannot_archive;
+
+     # There must be fixed_versions for us to look at the versioning
+     # information
+     if (@{$status->{fixed_versions}}) {
+         my %dist_tags;
+         @dist_tags{@{$config{removal_distribution_tags}}} =
+              (1) x @{$config{removal_distribution_tags}};
+         my %dists;
+         @dists{@{$config{removal_default_distribution_tags}}} = 
+              (1) x @{$config{removal_default_distribution_tags}};
+         for my $tag (split ' ', $status->{tags}) {
+              next unless $dist_tags{$tag};
+              $dists{$tag} = 1;
+         }
+         my %source_versions;
+         for my $dist (keys %dists){
+              my @versions;
+              @versions = getversions($status->{package},
+                                      $dist,
+                                      undef);
+              # TODO: This should probably be handled further out for efficiency and
+              # for more ease of distinguishing between pkg= and src= queries.
+              my @sourceversions = makesourceversions($status->{package},
+                                                      $dist,
+                                                      @versions);
+              @source_versions{@sourceversions} = (1) x @sourceversions;
+         }
+         if ('found' eq max_buggy(bug => $param{bug},
+                                  sourceversions => [keys %source_versions],
+                                  found          => $status->{found_versions},
+                                  fixed          => $status->{fixed_versions},
+                                  version_cache  => $version_cache,
+                                  package        => $status->{package},
+                                 )) {
+              return $cannot_archive;
+         }
      }
      # 6. at least 28 days have passed since the last action has occured or the bug was closed
      # XXX We still need some more work here before we actually can archive;
@@ -639,11 +650,11 @@ sub bug_archiveable{
 =item bug_index -- optional tied index of bug status infomration;
 currently not correctly implemented.
 
-=item version -- optional version to check package status at
+=item version -- optional version(s) to check package status at
 
-=item dist -- optional distribution to check package status at
+=item dist -- optional distribution(s) to check package status at
 
-=item arch -- optional architecture to check package status at
+=item arch -- optional architecture(s) to check package status at
 
 =item usertags -- optional hashref of usertags
 
@@ -672,13 +683,13 @@ sub get_bug_status {
                                          bug_index => {type => OBJECT,
                                                        optional => 1,
                                                       },
-                                         version   => {type => SCALAR,
+                                         version   => {type => SCALAR|ARRAYREF,
                                                        optional => 1,
                                                       },
-                                         dist       => {type => SCALAR,
+                                         dist       => {type => SCALAR|ARRAYREF,
                                                         optional => 1,
                                                        },
-                                         arch       => {type => SCALAR,
+                                         arch       => {type => SCALAR|ARRAYREF,
                                                         optional => 1,
                                                        },
                                          usertags   => {type => HASHREF,
@@ -725,45 +736,140 @@ sub get_bug_status {
      $status{"pending"} = 'pending-fixed'    if ($tags{pending});
      $status{"pending"} = 'fixed'          if ($tags{fixed});
 
+
+     my $presence = bug_presence(map{(exists $param{$_})?($_,$param{$_}):()}
+                                qw(bug sourceversions arch dist version found fixed package)
+                               );
+     if (defined $presence) {
+         if ($presence eq 'fixed') {
+              $status{pending} = 'done';
+         }
+         elsif ($presence eq 'absent') {
+              $status{pending} = 'absent';
+         }
+     }
+     return \%status;
+}
+
+=head2 bug_presence
+
+     my $precence = bug_presence(bug => nnn,
+                                 ...
+                                );
+
+Returns 'found', 'absent', 'fixed' or undef based on whether the bug
+is found, absent, fixed, or no information is available in the
+distribution (dist) and/or architecture (arch) specified.
+
+
+=head3 Options
+
+=over
+
+=item bug -- scalar bug number
+
+=item status -- optional hashref of bug status as returned by readbug
+(can be passed to avoid rereading the bug information)
+
+=item bug_index -- optional tied index of bug status infomration;
+currently not correctly implemented.
+
+=item version -- optional version to check package status at
+
+=item dist -- optional distribution to check package status at
+
+=item arch -- optional architecture to check package status at
+
+=item sourceversion -- optional arrayref of source/version; overrides
+dist, arch, and version. [The entries in this array must be in the
+"source/version" format.] Eventually this can be used to for caching.
+
+=back
+
+=cut
+
+sub bug_presence {
+     my %param = validate_with(params => \@_,
+                              spec   => {bug       => {type => SCALAR,
+                                                       regex => qr/^\d+$/,
+                                                      },
+                                         status    => {type => HASHREF,
+                                                       optional => 1,
+                                                      },
+                                         version   => {type => SCALAR|ARRAYREF,
+                                                       optional => 1,
+                                                      },
+                                         dist       => {type => SCALAR|ARRAYREF,
+                                                        optional => 1,
+                                                       },
+                                         arch       => {type => SCALAR|ARRAYREF,
+                                                        optional => 1,
+                                                       },
+                                         sourceversions => {type => ARRAYREF,
+                                                            optional => 1,
+                                                           },
+                                        },
+                             );
+     my %status;
+     if (defined $param{status}) {
+        %status = %{$param{status}};
+     }
+     else {
+         my $location = getbuglocation($param{bug}, 'summary');
+         return {} if not length $location;
+         %status = %{ readbug( $param{bug}, $location ) };
+     }
+
      my @sourceversions;
      if (not exists $param{sourceversions}) {
-         my @versions;
+         my %sourceversions;
          if (defined $param{version}) {
-              @versions = ($param{version});
+              foreach my $arch (make_list($param{arch})) {
+                   my @temp = makesourceversions($status{package},
+                                                 $arch,
+                                                 make_list($param{version})
+                                                );
+                   @sourceversions{@temp} = (1) x @temp;
+              }
          } elsif (defined $param{dist}) {
-              @versions = getversions($status{package}, $param{dist}, $param{arch});
+              foreach my $arch (make_list($param{arch})) {
+                   my @versions;
+                   foreach my $dist (make_list($param{dist})) {
+                        push @versions, getversions($status{package}, $dist, $arch);
+                   }
+                   my @temp = makesourceversions($status{package},
+                                                 $arch,
+                                                 @versions
+                                                );
+                   @sourceversions{@temp} = (1) x @temp;
+              }
          }
 
          # TODO: This should probably be handled further out for efficiency and
          # for more ease of distinguishing between pkg= and src= queries.
-         @sourceversions = makesourceversions($status{package},
-                                              $param{arch},
-                                              @versions);
+         @sourceversions = keys %sourceversions;
      }
      else {
          @sourceversions = @{$param{sourceversions}};
      }
+     my $maxbuggy = 'undef';
      if (@sourceversions) {
-         my $maxbuggy = max_buggy(bug => $param{bug},
+         $maxbuggy = max_buggy(bug => $param{bug},
                                   sourceversions => \@sourceversions,
                                   found => $status{found_versions},
                                   fixed => $status{fixed_versions},
                                   package => $status{package},
                                   version_cache => $version_cache,
                                  );
-         if ($maxbuggy eq 'absent') {
-              $status{pending} = 'absent';
-         }
-         elsif ($maxbuggy eq 'fixed' ) {
-              $status{pending} = 'done';
-         }
+     }
+     elsif (defined $param{dist}) {
+         return 'absent';
      }
      if (length($status{done}) and
         (not @sourceversions or not @{$status{fixed_versions}})) {
-         $status{"pending"} = 'done';
+         return 'fixed';
      }
-
-     return \%status;
+     return $maxbuggy;
 }
 
 
@@ -896,7 +1002,8 @@ sub buggy {
          $version = Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp);
          foreach my $source (keys %sources) {
               my $srchash = substr $source, 0, 1;
-              my $version_fh = new IO::File "$config{version_packages_dir}/$srchash/$source", 'r';
+              my $version_fh = new IO::File "$config{version_packages_dir}/$srchash/$source", 'r' or
+                   warn "Unable to open $config{version_packages_dir}/$srchash/$source: $!" and next;
               $version->load($version_fh);
          }
          if (defined $param{version_cache}) {
@@ -938,13 +1045,13 @@ sub update_realtime {
        }
 
        if ($new eq "NOCHANGE") {
-               print IDXNEW $line if ($line ne "" && $line[1] == $bug);
+               print IDXNEW $line if ($line ne ""  and $line[1] == $bug);
        } elsif ($new eq "REMOVE") {
                0;
        } else {
                print IDXNEW $new;
        }
-       if ($line ne "" && $line[1] > $bug) {
+       if (defined $line and $line ne "" and  @line and $line[1] > $bug) {
                print IDXNEW $line;
                $line = "";
        }
@@ -983,8 +1090,8 @@ sub bughook {
        (my $pkglist = $data->{package}) =~ s/[,\s]+/,/g;
        $pkglist =~ s/^,+//;
        $pkglist =~ s/,+$//;
-       $whendone = "forwarded" if length $data->{forwarded};
-       $whendone = "done" if length $data->{done};
+       $whendone = "forwarded" if defined $data->{forwarded} and length $data->{forwarded};
+       $whendone = "done" if defined $data->{done} and length $data->{done};
        $severity = $data->{severity} if length $data->{severity};
 
        my $k = sprintf "%s %d %d %s [%s] %s %s\n",