6 Debbugs::Bugs -- Bug selection routines for debbugs
10 use Debbugs::Bugs qw(get_bugs);
15 This module is a replacement for all of the various methods of
16 selecting different types of bugs.
18 It implements a single function, get_bugs, which defines the master
19 interface for selecting bugs.
21 It attempts to use subsidiary functions to actually do the selection,
22 in the order specified in the configuration files. [Unless you're
23 insane, they should be in order from fastest (and often most
24 incomplete) to slowest (and most complete).]
34 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
35 use base qw(Exporter);
39 $DEBUG = 0 unless defined $DEBUG;
43 @EXPORT_OK = (qw(get_bugs));
44 $EXPORT_TAGS{all} = [@EXPORT_OK];
47 use Debbugs::Config qw(:config);
48 use Params::Validate qw(validate_with :types);
50 use Debbugs::Status qw(splitpackages);
51 use Debbugs::Packages qw(getsrcpkgs);
52 use Debbugs::Common qw(getparsedaddrs getmaintainers getmaintainers_reverse);
53 use Fcntl qw(O_RDONLY);
54 use MLDBM qw(DB_File Storable);
62 The following parameters can either be a single scalar or a reference
63 to an array. The parameters are ANDed together, and the elements of
64 arrayrefs are a parameter are ORed. Future versions of this may allow
65 for limited regular expressions, and/or more complex expressions.
69 =item package -- name of the binary package
71 =item src -- name of the source package
73 =item maint -- address of the maintainer
75 =item submitter -- address of the submitter
77 =item severity -- severity of the bug
79 =item status -- status of the bug
83 =item owner -- owner of the bug
85 =item dist -- distribution (I don't know about this one yet)
87 =item bugs -- list of bugs to search within
89 =item function -- see description below
93 =head3 Special options
95 The following options are special options used to modulate how the
96 searches are performed.
100 =item archive -- whether to search archived bugs or normal bugs;
103 =item usertags -- set of usertags and the bugs they are applied to
108 =head3 Subsidiary routines
110 All subsidiary routines get passed exactly the same set of options as
111 get_bugs. If for some reason they are unable to handle the options
112 passed (for example, they don't have the right type of index for the
113 type of selection) they should die as early as possible. [Using
114 Params::Validate and/or die when files don't exist makes this fairly
117 This function will then immediately move on to the next subroutine,
118 giving it the same arguments.
122 This option allows you to provide an arbitrary function which will be
123 given the information in the index.db file. This will be super, super
124 slow, so only do this if there's no other way to write the search.
126 You'll be given a list (which you can turn into a hash) like the
129 (pkg => ['a','b'], # may be a scalar (most common)
132 submitter => 'boo@baz.com',
133 severity => 'serious',
134 tags => ['a','b','c'], # may be an empty arrayref
137 The function should return 1 if the bug should be included; 0 if the
143 my %param = validate_with(params => \@_,
144 spec => {package => {type => SCALAR|ARRAYREF,
147 src => {type => SCALAR|ARRAYREF,
150 maint => {type => SCALAR|ARRAYREF,
153 submitter => {type => SCALAR|ARRAYREF,
156 severity => {type => SCALAR|ARRAYREF,
159 status => {type => SCALAR|ARRAYREF,
162 tag => {type => SCALAR|ARRAYREF,
165 owner => {type => SCALAR|ARRAYREF,
168 dist => {type => SCALAR|ARRAYREF,
171 function => {type => CODEREF,
174 bugs => {type => SCALAR|ARRAYREF,
177 archive => {type => BOOLEAN,
180 usertags => {type => HASHREF,
187 my %options = %param;
189 # A configuration option will set an array that we'll use here instead.
190 for my $routine (qw(Debbugs::Bugs::get_bugs_by_idx Debbugs::Bugs::get_bugs_flatfile)) {
191 my ($package) = $routine =~ m/^(.+)\:\:/;
192 eval "use $package;";
194 # We output errors here because using an invalid function
195 # in the configuration file isn't something that should
197 warn "use $package failed with $@";
200 @bugs = eval "${routine}(\%options)";
203 # We don't output errors here, because failure here
204 # via die may be a perfectly normal thing.
205 print STDERR "$@" if $DEBUG;
210 # If no one succeeded, die
217 =head2 get_bugs_by_idx
219 This routine uses the by-$index.idx indicies to try to speed up
226 my %param = validate_with(params => \@_,
227 spec => {package => {type => SCALAR|ARRAYREF,
230 submitter => {type => SCALAR|ARRAYREF,
233 severity => {type => SCALAR|ARRAYREF,
236 tag => {type => SCALAR|ARRAYREF,
239 archive => {type => BOOLEAN,
242 src => {type => SCALAR|ARRAYREF,
245 maint => {type => SCALAR|ARRAYREF,
252 # We handle src packages, maint and maintenc by mapping to the
253 # appropriate binary packages, then removing all packages which
254 # don't match all queries
255 my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
256 qw(package src maint)
258 if (exists $param{package} or
259 exists $param{src} or
260 exists $param{maint}) {
261 delete @param{qw(maint src)};
262 $param{package} = [@packages];
264 my $keys = keys(%param) - 1;
265 die "Need at least 1 key to search by" unless $keys;
266 my $arc = $param{archive} ? '-arc':'';
268 for my $key (grep {$_ ne 'archive'} keys %param) {
270 $index = 'submitter-email' if $key eq 'submitter';
271 $index = "$config{spool_dir}/by-${index}${arc}.idx";
272 tie(%idx, MLDBM => $index, O_RDONLY)
273 or die "Unable to open $index: $!";
274 for my $search (__make_list($param{$key})) {
275 next unless defined $idx{$search};
276 for my $bug (keys %{$idx{$search}}) {
277 # increment the number of searches that this bug matched
281 untie %idx or die 'Unable to untie %idx';
283 # Throw out results that do not match all of the search specifications
284 return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
288 =head2 get_bugs_flatfile
290 This is the fallback search routine. It should be able to complete all
291 searches. [Or at least, that's the idea.]
295 sub get_bugs_flatfile{
296 my %param = validate_with(params => \@_,
297 spec => {package => {type => SCALAR|ARRAYREF,
300 src => {type => SCALAR|ARRAYREF,
303 maint => {type => SCALAR|ARRAYREF,
306 submitter => {type => SCALAR|ARRAYREF,
309 severity => {type => SCALAR|ARRAYREF,
312 status => {type => SCALAR|ARRAYREF,
315 tag => {type => SCALAR|ARRAYREF,
319 # owner => {type => SCALAR|ARRAYREF,
322 # dist => {type => SCALAR|ARRAYREF,
325 archive => {type => BOOLEAN,
328 usertags => {type => HASHREF,
331 function => {type => CODEREF,
337 if ($param{archive}) {
338 $flatfile = new IO::File "$debbugs::gSpoolDir/index.archive", 'r'
339 or die "Unable to open $debbugs::gSpoolDir/index.archive for reading: $!";
342 $flatfile = new IO::File "$debbugs::gSpoolDir/index.db", 'r'
343 or die "Unable to open $debbugs::gSpoolDir/index.db for reading: $!";
346 if (exists $param{tag} and exists $param{usertags}) {
348 # This complex slice makes a hash with the bugs which have the
349 # usertags passed in $param{tag} set.
350 @usertag_bugs{map {@{$_}}
351 @{$param{usertags}}{__make_list($param{tag})}
352 } = (1) x @{$param{usertags}}{__make_list($param{tag})}
354 # We handle src packages, maint and maintenc by mapping to the
355 # appropriate binary packages, then removing all packages which
356 # don't match all queries
357 my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
358 qw(package src maint)
360 if (exists $param{package} or
361 exists $param{src} or
362 exists $param{maint}) {
363 delete @param{qw(maint src)};
364 $param{package} = [@packages];
367 while (<$flatfile>) {
368 next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
369 my ($pkg,$bug,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
370 next if exists $param{bug} and not grep {$bug == $_} __make_list($param{bugs});
371 if (exists $param{pkg}) {
372 my @packages = splitpackages($pkg);
373 next unless grep { my $pkg_list = $_;
374 grep {$pkg_list eq $_} __make_list($param{pkg})
377 if (exists $param{src}) {
378 my @src_packages = map { getsrcpkgs($_)} __make_list($param{src});
379 my @packages = splitpackages($pkg);
380 next unless grep { my $pkg_list = $_;
381 grep {$pkg_list eq $_} @packages
384 if (exists $param{submitter}) {
385 my @p_addrs = map {$_->address}
386 map {lc(getparsedaddrs($_))}
387 __make_list($param{submitter});
388 my @f_addrs = map {$_->address}
389 getparsedaddrs($submitter||'');
390 next unless grep { my $f_addr = $_;
391 grep {$f_addr eq $_} @p_addrs
394 next if exists $param{severity} and not grep {$severity eq $_} __make_list($param{severity});
395 next if exists $param{status} and not grep {$status eq $_} __make_list($param{status});
396 if (exists $param{tag}) {
398 # either a normal tag, or a usertag must be set
399 $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
400 my @bug_tags = split ' ', $tags;
401 $bug_ok = 1 if grep {my $bug_tag = $_;
402 grep {$bug_tag eq $_} __make_list($param{tag});
406 # We do this last, because a function may be slow...
407 if (exists $param{function}) {
408 my @bug_tags = split ' ', $tags;
409 my @packages = splitpackages($pkg);
410 my $package = (@packages > 1)?\@packages:$packages[0];
412 $param{function}->(pkg => $package,
415 submitter => $submitter,
416 severity => $severity,
425 sub __handle_pkg_src_and_maint{
426 my %param = validate_with(params => \@_,
427 spec => {package => {type => SCALAR|ARRAYREF,
430 src => {type => SCALAR|ARRAYREF,
433 maint => {type => SCALAR|ARRAYREF,
440 my @packages = __make_list($param{package});
441 my $package_keys = @packages?1:0;
443 @packages{@packages} = (1) x @packages;
444 if (exists $param{src}) {
445 # We only want to increment the number of keys if there is
448 for my $package (map { getsrcpkgs($_)} __make_list($param{src})) {
449 $packages{$package}++;
452 $package_keys += $key_inc;
454 if (exists $param{maint}) {
456 my $maint_rev = getmaintainers_reverse();
457 for my $package (map { exists $maint_rev->{$_}?@{$maint_rev->{$_}}:()}
458 __make_list($param{maint})) {
459 $packages{$package}++;
462 $package_keys += $key_inc;
464 return grep {$packages{$_} >= $package_keys} keys %packages;
468 # This private subroutine takes a scalar and turns it into a list;
469 # transforming arrayrefs into their contents along the way. It also
470 # turns undef into the empty list.
472 return map {defined $_?(ref($_) eq 'ARRAY'?@{$_}:$_):()} @_;