X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FBugs.pm;h=f8e049ddf6633fd755762a697abda6e9e6ee70f8;hb=ef8bd23ff686d78c1fbc8e51bdeb0630f1f53fae;hp=9bfd4ae3c620d0ccc9678212f5ddd18bf783d5e3;hpb=9a05998d2232d72e246ac6e4b5b3e5e5085cc30a;p=debbugs.git diff --git a/Debbugs/Bugs.pm b/Debbugs/Bugs.pm index 9bfd4ae..f8e049d 100644 --- a/Debbugs/Bugs.pm +++ b/Debbugs/Bugs.pm @@ -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,11 +54,11 @@ 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); +use List::AllUtils qw(first); use Carp; =head2 get_bugs @@ -92,6 +92,8 @@ for limited regular expressions, and/or more complex expressions. =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 @@ -182,6 +184,9 @@ sub get_bugs{ correspondent => {type => SCALAR|ARRAYREF, optional => 1, }, + affects => {type => SCALAR|ARRAYREF, + optional => 1, + }, function => {type => CODEREF, optional => 1, }, @@ -320,7 +325,7 @@ sub bug_filter { optional => 1, }, repeat_merged => {type => BOOLEAN, - optional => 1, + default => 1, }, include => {type => HASHREF, optional => 1, @@ -415,6 +420,9 @@ sub get_bugs_by_idx{ correspondent => {type => SCALAR|ARRAYREF, optional => 1, }, + affects => {type => SCALAR|ARRAYREF, + optional => 1, + }, usertags => {type => HASHREF, optional => 1, }, @@ -422,6 +430,14 @@ 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 @@ -517,10 +533,16 @@ sub get_bugs_flatfile{ correspondent => {type => SCALAR|ARRAYREF, optional => 1, }, + affects => {type => SCALAR|ARRAYREF, + optional => 1, + }, # not yet supported # dist => {type => SCALAR|ARRAYREF, # optional => 1, # }, + bugs => {type => SCALAR|ARRAYREF, + optional => 1, + }, archive => {type => BOOLEAN, default => 1, }, @@ -548,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 @@ -558,7 +604,7 @@ 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; @@ -566,15 +612,18 @@ sub get_bugs_flatfile{ $bugs{$_} = 1 for make_list($param{bugs}); $grep_bugs = 1; } - if (exists $param{owner} or exists $param{correspondent}) { - $bugs{$_} = 1 for get_bugs_by_idx(exists $param{correspondent}?(correspondent => $param{correspondent}):(), - exists $param{owner}?(owner => $param{owner}):(), + # 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 $grep_bugs and not exists $bugs{$bug}; if (exists $param{package}) { @@ -617,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; } @@ -667,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; @@ -708,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;