X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FBugs.pm;h=36bcc7b487e6c6c1c3d84de20c66aff68445b104;hb=42968ad723d526ffa327bf8399a044ba75a89361;hp=9879e3fd1a8f7f34d50d75657d23fd254b608319;hpb=4dd2c3f274331284fc6ce35a88234a8a4dd3c955;p=debbugs.git

diff --git a/Debbugs/Bugs.pm b/Debbugs/Bugs.pm
index 9879e3f..36bcc7b 100644
--- a/Debbugs/Bugs.pm
+++ b/Debbugs/Bugs.pm
@@ -46,18 +46,20 @@ BEGIN{
 
      @EXPORT = ();
      %EXPORT_TAGS = ();
-     @EXPORT_OK = (qw(get_bugs count_bugs newest_bug));
+     @EXPORT_OK = (qw(get_bugs count_bugs newest_bug bug_filter));
      $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
 use Debbugs::Config qw(:config);
 use Params::Validate qw(validate_with :types);
 use IO::File;
-use Debbugs::Status qw(splitpackages);
+use Debbugs::Status qw(splitpackages get_bug_status);
 use Debbugs::Packages qw(getsrcpkgs);
 use Debbugs::Common qw(getparsedaddrs getmaintainers getmaintainers_reverse make_list);
 use Fcntl qw(O_RDONLY);
 use MLDBM qw(DB_File Storable);
+use List::Util qw(first);
+use Carp;
 
 =head2 get_bugs
 
@@ -88,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
@@ -175,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,
 						       },
@@ -288,7 +300,83 @@ 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
+
+     bug_filter
+
+Allows filtering bugs on commonly used criteria
+
+
+
+=cut
+
+sub bug_filter {
+     my %param = validate_with(params => \@_,
+			       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,
+							   },
+					  include => {type => HASHREF,
+						      optional => 1,
+						     },
+					  exclude => {type => HASHREF,
+						      optional => 1,
+						     },
+					  min_days => {type => SCALAR,
+						       optional => 1,
+						      },
+					  max_days => {type => SCALAR,
+						       optional => 1,
+						      },
+					 },
+			      );
+     if (exists $param{repeat_merged} and
+	 not $param{repeat_merged} and
+	 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');
+	  return 0 if not defined $location or not length $location;
+	  $param{status} = readbug( $param{bug}, $location );
+	  return 0 if not defined $param{status};
+     }
+
+     if (exists $param{include}) {
+	  return 1 if (!__bug_matches($param{include}, $param{status}));
+     }
+     if (exists $param{exclude}) {
+	  return 1 if (__bug_matches($param{exclude}, $param{status}));
+     }
+     if (exists $param{repeat_merged} and not $param{repeat_merged}) {
+	  my @merged = sort {$a<=>$b} $param{bug}, split(/ /, $param{status}{mergedwith});
+	  return 1 if first {defined $_} @{$param{seen_merged}}{@merged};
+	  @{$param{seen_merged}}{@merged} = (1) x @merged;
+     }
+     my $daysold = int((time - $param{status}{date}) / 86400);   # seconds to days
+     if (exists $param{min_days}) {
+	  return 1 unless $param{min_days} <= $daysold;
+     }
+     if (exists $param{max_days}) {
+	  return 1 unless $param{max_days} == -1 or
+	       $param{max_days} >= $daysold;
+     }
+     return 0;
 }
 
 
@@ -329,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,
 						       },
@@ -342,20 +436,13 @@ sub get_bugs_by_idx{
      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;
@@ -367,13 +454,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})})) {
@@ -425,10 +519,16 @@ 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,
 # 						       },
@@ -471,11 +571,24 @@ sub get_bugs_flatfile{
 	  delete @param{qw(maint src)};
 	  $param{package} = [@packages];
      }
+     my $grep_bugs = 0;
+     my %bugs;
+     if (exists $param{bugs}) {
+	  $bugs{$_} = 1 for make_list($param{bugs});
+	  $grep_bugs = 1;
+     }
+     if (exists $param{owner} or exists $param{correspondent} or exists $param{affects}) {
+	  $bugs{$_} = 1 for get_bugs_by_idx(exists $param{correspondent}?(correspondent => $param{correspondent}):(),
+					    exists $param{owner}?(owner => $param{owner}):(),
+					    exists $param{affects}?(affects => $param{affects}):(),
+					   );
+	  $grep_bugs = 1;
+     }
      my @bugs;
      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 = $_;
@@ -530,6 +643,18 @@ sub get_bugs_flatfile{
      return @bugs;
 }
 
+=head1 PRIVATE FUNCTIONS
+
+=head2 __handle_pkg_src_and_maint
+
+     my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
+					       qw(package src maint)
+					      );
+
+Turn package/src/maint into a list of packages
+
+=cut
+
 sub __handle_pkg_src_and_maint{
      my %param = validate_with(params => \@_,
 			       spec   => {package   => {type => SCALAR|ARRAYREF,
@@ -573,6 +698,52 @@ sub __handle_pkg_src_and_maint{
      return grep {$packages{$_} >= $package_keys} keys %packages;
 }
 
+my %field_match = (
+    'subject' => \&__contains_field_match,
+    'tags' => sub {
+        my ($field, $values, $status) = @_; 
+	my %values = map {$_=>1} @$values;
+	foreach my $t (split /\s+/, $status->{$field}) {
+            return 1 if (defined $values{$t});
+        }
+        return 0;
+    },
+    'severity' => \&__exact_field_match,
+    'pending' => \&__exact_field_match,
+    'package' => \&__exact_field_match,
+    'originator' => \&__contains_field_match,
+    'forwarded' => \&__contains_field_match,
+    'owner' => \&__contains_field_match,
+);
+
+sub __bug_matches {
+    my ($hash, $status) = @_;
+    foreach my $key( keys( %$hash ) ) {
+        my $value = $hash->{$key};
+	my $sub = $field_match{$key};
+	return 1 if ($sub->($key, $value, $status));
+    }
+    return 0;
+}
+
+sub __exact_field_match {
+    my ($field, $values, $status) = @_; 
+    my @values = @$values;
+    my @ret = grep {$_ eq $status->{$field} } @values;
+    $#ret != -1;
+}
+
+sub __contains_field_match {
+    my ($field, $values, $status) = @_; 
+    foreach my $data (@$values) {
+        return 1 if (index($status->{$field}, $data) > -1);
+    }
+    return 0;
+}
+
+
+
+
 
 1;