]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Bugs.pm
Prefer "use Exporter qw(import)" to inheriting from it
[debbugs.git] / Debbugs / Bugs.pm
index 848931f79b8fcca9799324a814630ee2d77666a8..e678aff43c1274e339e8e6d38c3d03e172a578e7 100644 (file)
@@ -38,7 +38,7 @@ incomplete) to slowest (and most complete).]
 use warnings;
 use strict;
 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
+use Exporter qw(import);
 
 BEGIN{
      $VERSION = 1.00;
@@ -54,8 +54,8 @@ use Debbugs::Config qw(:config);
 use Params::Validate qw(validate_with :types);
 use IO::File;
 use Debbugs::Status qw(splitpackages get_bug_status);
-use Debbugs::Packages qw(getsrcpkgs);
-use Debbugs::Common qw(getparsedaddrs getmaintainers getmaintainers_reverse make_list);
+use Debbugs::Packages qw(getsrcpkgs getpkgsrc);
+use Debbugs::Common qw(getparsedaddrs package_maintainer getmaintainers make_list);
 use Fcntl qw(O_RDONLY);
 use MLDBM qw(DB_File Storable);
 use List::Util qw(first);
@@ -90,6 +90,10 @@ for limited regular expressions, and/or more complex expressions.
 
 =item owner -- owner of the bug
 
+=item correspondent -- address of someone who sent mail to the log
+
+=item affects -- bugs which affect this package
+
 =item dist -- distribution (I don't know about this one yet)
 
 =item bugs -- list of bugs to search within
@@ -177,6 +181,12 @@ sub get_bugs{
                                          dist      => {type => SCALAR|ARRAYREF,
                                                        optional => 1,
                                                       },
+                                         correspondent => {type => SCALAR|ARRAYREF,
+                                                           optional => 1,
+                                                          },
+                                         affects   => {type => SCALAR|ARRAYREF,
+                                                       optional => 1,
+                                                      },
                                          function  => {type => CODEREF,
                                                        optional => 1,
                                                       },
@@ -290,7 +300,7 @@ sub newest_bug {
      my $next_number = <$nn_fh>;
      close $nn_fh;
      chomp $next_number;
-     return $next_number+0;
+     return $next_number-1;
 }
 
 =head2 bug_filter
@@ -299,21 +309,23 @@ sub newest_bug {
 
 Allows filtering bugs on commonly used criteria
 
+
+
 =cut
 
 sub bug_filter {
      my %param = validate_with(params => \@_,
-                              spec   => {bug => {type  => SCALAR,
-                                                 regex => qr/^\d+$/,
-                                                },
-                                         status => {type => HASHREF,
+                              spec   => {bug    => {type => ARRAYREF|SCALAR,
+                                                    optional => 1,
+                                                   },
+                                         status => {type => HASHREF|ARRAYREF,
                                                     optional => 1,
                                                    },
                                          seen_merged => {type => HASHREF,
                                                          optional => 1,
                                                         },
                                          repeat_merged => {type => BOOLEAN,
-                                                           optional => 1,
+                                                           default => 1,
                                                           },
                                          include => {type => HASHREF,
                                                      optional => 1,
@@ -334,6 +346,9 @@ sub bug_filter {
         not defined $param{seen_merged}) {
          croak "repeat_merged false requires seen_merged to be passed";
      }
+     if (not exists $param{bug} and not exists $param{status}) {
+        croak "one of bug or status must be passed";
+     }
 
      if (not exists $param{status}) {
          my $location = getbuglocation($param{bug}, 'summary');
@@ -402,6 +417,12 @@ sub get_bugs_by_idx{
                                          bugs      => {type => SCALAR|ARRAYREF,
                                                        optional => 1,
                                                       },
+                                         correspondent => {type => SCALAR|ARRAYREF,
+                                                           optional => 1,
+                                                          },
+                                         affects => {type => SCALAR|ARRAYREF,
+                                                     optional => 1,
+                                                    },
                                          usertags  => {type => HASHREF,
                                                        optional => 1,
                                                       },
@@ -409,26 +430,27 @@ sub get_bugs_by_idx{
                              );
      my %bugs = ();
 
+     # If we're given an empty maint (unmaintained packages), we can't
+     # handle it, so bail out here
+     for my $maint (make_list(exists $param{maint}?$param{maint}:[])) {
+         if (defined $maint and $maint eq '') {
+              die "Can't handle empty maint (unmaintained packages) in get_bugs_by_idx";
+         }
+     }
+
      # We handle src packages, maint and maintenc by mapping to the
      # appropriate binary packages, then removing all packages which
      # don't match all queries
      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
                                               qw(package src maint)
                                              );
-     my %usertag_bugs;
-     if (exists $param{tag} and exists $param{usertags}) {
-         # This complex slice makes a hash with the bugs which have the
-          # usertags passed in $param{tag} set.
-         @usertag_bugs{make_list(@{$param{usertags}}{make_list($param{tag})})
-                       } = (1) x make_list(@{$param{usertags}}{make_list($param{tag})});
-     }
      if (exists $param{package} or
         exists $param{src} or
         exists $param{maint}) {
          delete @param{qw(maint src)};
          $param{package} = [@packages];
      }
-     my $keys = keys(%param) - 1;
+     my $keys = grep {$_ !~ /^(archive|usertags|bugs)$/} keys(%param);
      die "Need at least 1 key to search by" unless $keys;
      my $arc = $param{archive} ? '-arc':'';
      my %idx;
@@ -440,13 +462,20 @@ sub get_bugs_by_idx{
               or die "Unable to open $index: $!";
          my %bug_matching = ();
          for my $search (make_list($param{$key})) {
-              next unless defined $idx{$search};
-              for my $bug (keys %{$idx{$search}}) {
+              for my $bug (keys %{$idx{$search}||{}}) {
                    next if $bug_matching{$bug};
                    # increment the number of searches that this bug matched
                    $bugs{$bug}++;
                    $bug_matching{$bug}=1;
               }
+              if ($search ne lc($search)) {
+                   for my $bug (keys %{$idx{lc($search)}||{}}) {
+                        next if $bug_matching{$bug};
+                        # increment the number of searches that this bug matched
+                        $bugs{$bug}++;
+                        $bug_matching{$bug}=1;
+                   }
+              }
          }
          if ($key eq 'tag' and exists $param{usertags}) {
               for my $bug (make_list(grep {defined $_ } @{$param{usertags}}{make_list($param{tag})})) {
@@ -498,13 +527,22 @@ sub get_bugs_flatfile{
                                          tag       => {type => SCALAR|ARRAYREF,
                                                        optional => 1,
                                                       },
+                                         owner     => {type => SCALAR|ARRAYREF,
+                                                       optional => 1,
+                                                      },
+                                         correspondent => {type => SCALAR|ARRAYREF,
+                                                           optional => 1,
+                                                          },
+                                         affects   => {type => SCALAR|ARRAYREF,
+                                                       optional => 1,
+                                                      },
 # not yet supported
-#                                        owner     => {type => SCALAR|ARRAYREF,
-#                                                      optional => 1,
-#                                                     },
 #                                        dist      => {type => SCALAR|ARRAYREF,
 #                                                      optional => 1,
 #                                                     },
+                                         bugs      => {type => SCALAR|ARRAYREF,
+                                                       optional => 1,
+                                                      },
                                          archive   => {type => BOOLEAN,
                                                        default => 1,
                                                       },
@@ -532,6 +570,30 @@ sub get_bugs_flatfile{
          @usertag_bugs{make_list(@{$param{usertags}}{make_list($param{tag})})
                        } = (1) x make_list(@{$param{usertags}}{make_list($param{tag})});
      }
+     my $unmaintained_packages = 0;
+     # unmaintained packages is a special case
+     my @maints = make_list(exists $param{maint}?$param{maint}:[]);
+     $param{maint} = [];
+     for my $maint (@maints) {
+         if (defined $maint and $maint eq '' and not $unmaintained_packages) {
+              $unmaintained_packages = 1;
+              our %maintainers = %{getmaintainers()};
+              $param{function} = [(exists $param{function}?
+                                   (ref $param{function}?@{$param{function}}:$param{function}):()),
+                                  sub {my %d=@_;
+                                       foreach my $try (make_list($d{"pkg"})) {
+                                            next unless length $try;
+                                            ($try) = $try =~ m/^(?:src:)?(.+)/;
+                                            return 1 if not exists $maintainers{$try};
+                                       }
+                                       return 0;
+                                  }
+                                 ];
+         }
+         elsif (defined $maint and $maint ne '') {
+              push @{$param{maint}},$maint;
+         }
+     }
      # We handle src packages, maint and maintenc by mapping to the
      # appropriate binary packages, then removing all packages which
      # don't match all queries
@@ -542,13 +604,28 @@ sub get_bugs_flatfile{
         exists $param{src} or
         exists $param{maint}) {
          delete @param{qw(maint src)};
-         $param{package} = [@packages];
+         $param{package} = [@packages] if @packages;
+     }
+     my $grep_bugs = 0;
+     my %bugs;
+     if (exists $param{bugs}) {
+         $bugs{$_} = 1 for make_list($param{bugs});
+         $grep_bugs = 1;
+     }
+     # These queries have to be handled by get_bugs_by_idx
+     if (exists $param{owner}
+        or exists $param{correspondent}
+        or exists $param{affects}) {
+         $bugs{$_} = 1 for get_bugs_by_idx(map {exists $param{$_}?($_,$param{$_}):()}
+                                           qw(owner correspondent affects),
+                                          );
+         $grep_bugs = 1;
      }
      my @bugs;
-     while (<$flatfile>) {
-         next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
+     BUG: while (<$flatfile>) {
+         next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*(.*)\s*\]\s+(\w+)\s+(.*)$/;
          my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
-         next if exists $param{bugs} and not grep {$bug == $_} make_list($param{bugs});
+         next if $grep_bugs and not exists $bugs{$bug};
          if (exists $param{package}) {
               my @packages = splitpackages($pkg);
               next unless grep { my $pkg_list = $_;
@@ -589,14 +666,16 @@ sub get_bugs_flatfile{
               my @bug_tags = split ' ', $tags;
               my @packages = splitpackages($pkg);
               my $package = (@packages > 1)?\@packages:$packages[0];
-              next unless
-                   $param{function}->(pkg       => $package,
-                                      bug       => $bug,
-                                      status    => $status,
-                                      submitter => $submitter,
-                                      severity  => $severity,
-                                      tags      => \@bug_tags,
-                                     );
+              for my $function (make_list($param{function})) {
+                   next BUG unless
+                        $function->(pkg       => $package,
+                                    bug       => $bug,
+                                    status    => $status,
+                                    submitter => $submitter,
+                                    severity  => $severity,
+                                    tags      => \@bug_tags,
+                                   );
+              }
          }
          push @bugs, $bug;
      }
@@ -639,18 +718,34 @@ sub __handle_pkg_src_and_maint{
          # We only want to increment the number of keys if there is
          # something to match
          my $key_inc = 0;
-         for my $package ((map { getsrcpkgs($_)} make_list($param{src})),make_list($param{src})) {
-              $packages{$package}++;
+         # in case there are binaries with the same name as the
+         # source
+         my %_temp_p = ();
+         for my $package ((map {getsrcpkgs($_)} make_list($param{src}))) {
+              $packages{$package}++ unless exists $_temp_p{$package};
+              $_temp_p{$package} = 1;
               $key_inc=1;
          }
+         for my $package (make_list($param{src})) {
+              $packages{"src:$package"}++ unless exists $_temp_p{"src:$package"};
+              $_temp_p{"src:$package"} = 1;
+              $key_inc=1;
+              # As a temporary hack, we will also include $param{src}
+              # in this list for packages passed which do not have a
+              # corresponding binary package
+              if (not exists getpkgsrc()->{$package}) {
+                  $packages{$package}++ unless exists $_temp_p{$package};
+                  $_temp_p{$package} = 1;
+              }
+         }
          $package_keys += $key_inc;
      }
      if (exists $param{maint}) {
          my $key_inc = 0;
-         my $maint_rev = getmaintainers_reverse();
-         for my $package (map { exists $maint_rev->{$_}?@{$maint_rev->{$_}}:()}
-                          make_list($param{maint})) {
-              $packages{$package}++;
+         my %_temp_p = ();
+         for my $package (package_maintainer(maintainer=>$param{maint})) {
+              $packages{$package}++ unless exists $_temp_p{$package};
+              $_temp_p{$package} = 1;
               $key_inc = 1;
          }
          $package_keys += $key_inc;
@@ -670,6 +765,7 @@ my %field_match = (
     },
     'severity' => \&__exact_field_match,
     'pending' => \&__exact_field_match,
+    'package' => \&__exact_field_match,
     'originator' => \&__contains_field_match,
     'forwarded' => \&__contains_field_match,
     'owner' => \&__contains_field_match,
@@ -679,7 +775,11 @@ sub __bug_matches {
     my ($hash, $status) = @_;
     foreach my $key( keys( %$hash ) ) {
         my $value = $hash->{$key};
+       next unless exists $field_match{$key};
        my $sub = $field_match{$key};
+       if (not defined $sub) {
+           die "No defined subroutine for key: $key";
+       }
        return 1 if ($sub->($key, $value, $status));
     }
     return 0;