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 count_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
219 count_bugs(function => sub {...})
221 Uses a subroutine to classify bugs into categories and return the
222 number of bugs which fall into those categories
227 my %param = validate_with(params => \@_,
228 spec => {function => {type => CODEREF,
230 archive => {type => BOOLEAN,
236 if ($param{archive}) {
237 $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
238 or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
241 $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
242 or die "Unable to open $config{spool_dir}/index.db for reading: $!";
246 if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) {
247 my @x = $param{function}->(pkg => $1,
255 $count{$_}++ foreach @x;
263 =head2 get_bugs_by_idx
265 This routine uses the by-$index.idx indicies to try to speed up
272 my %param = validate_with(params => \@_,
273 spec => {package => {type => SCALAR|ARRAYREF,
276 submitter => {type => SCALAR|ARRAYREF,
279 severity => {type => SCALAR|ARRAYREF,
282 tag => {type => SCALAR|ARRAYREF,
285 archive => {type => BOOLEAN,
288 owner => {type => SCALAR|ARRAYREF,
291 src => {type => SCALAR|ARRAYREF,
294 maint => {type => SCALAR|ARRAYREF,
301 # We handle src packages, maint and maintenc by mapping to the
302 # appropriate binary packages, then removing all packages which
303 # don't match all queries
304 my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
305 qw(package src maint)
307 if (exists $param{package} or
308 exists $param{src} or
309 exists $param{maint}) {
310 delete @param{qw(maint src)};
311 $param{package} = [@packages];
313 my $keys = keys(%param) - 1;
314 die "Need at least 1 key to search by" unless $keys;
315 my $arc = $param{archive} ? '-arc':'';
317 for my $key (grep {$_ ne 'archive'} keys %param) {
319 $index = 'submitter-email' if $key eq 'submitter';
320 $index = "$config{spool_dir}/by-${index}${arc}.idx";
321 tie(%idx, MLDBM => $index, O_RDONLY)
322 or die "Unable to open $index: $!";
323 for my $search (__make_list($param{$key})) {
324 next unless defined $idx{$search};
325 for my $bug (keys %{$idx{$search}}) {
326 # increment the number of searches that this bug matched
330 untie %idx or die 'Unable to untie %idx';
332 # Throw out results that do not match all of the search specifications
333 return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
337 =head2 get_bugs_flatfile
339 This is the fallback search routine. It should be able to complete all
340 searches. [Or at least, that's the idea.]
344 sub get_bugs_flatfile{
345 my %param = validate_with(params => \@_,
346 spec => {package => {type => SCALAR|ARRAYREF,
349 src => {type => SCALAR|ARRAYREF,
352 maint => {type => SCALAR|ARRAYREF,
355 submitter => {type => SCALAR|ARRAYREF,
358 severity => {type => SCALAR|ARRAYREF,
361 status => {type => SCALAR|ARRAYREF,
364 tag => {type => SCALAR|ARRAYREF,
368 # owner => {type => SCALAR|ARRAYREF,
371 # dist => {type => SCALAR|ARRAYREF,
374 archive => {type => BOOLEAN,
377 usertags => {type => HASHREF,
380 function => {type => CODEREF,
386 if ($param{archive}) {
387 $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
388 or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
391 $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
392 or die "Unable to open $config{spool_dir}/index.db for reading: $!";
395 if (exists $param{tag} and exists $param{usertags}) {
397 # This complex slice makes a hash with the bugs which have the
398 # usertags passed in $param{tag} set.
399 @usertag_bugs{map {@{$_}}
400 @{$param{usertags}}{__make_list($param{tag})}
401 } = (1) x @{$param{usertags}}{__make_list($param{tag})}
403 # We handle src packages, maint and maintenc by mapping to the
404 # appropriate binary packages, then removing all packages which
405 # don't match all queries
406 my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
407 qw(package src maint)
409 if (exists $param{package} or
410 exists $param{src} or
411 exists $param{maint}) {
412 delete @param{qw(maint src)};
413 $param{package} = [@packages];
416 while (<$flatfile>) {
417 next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
418 my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
419 next if exists $param{bugs} and not grep {$bug == $_} __make_list($param{bugs});
420 if (exists $param{package}) {
421 my @packages = splitpackages($pkg);
422 next unless grep { my $pkg_list = $_;
423 grep {$pkg_list eq $_} __make_list($param{package})
426 if (exists $param{src}) {
427 my @src_packages = map { getsrcpkgs($_)} __make_list($param{src});
428 my @packages = splitpackages($pkg);
429 next unless grep { my $pkg_list = $_;
430 grep {$pkg_list eq $_} @packages
433 if (exists $param{submitter}) {
434 my @p_addrs = map {lc($_->address)}
435 map {getparsedaddrs($_)}
436 __make_list($param{submitter});
437 my @f_addrs = map {$_->address}
438 getparsedaddrs($submitter||'');
439 next unless grep { my $f_addr = $_;
440 grep {$f_addr eq $_} @p_addrs
443 next if exists $param{severity} and not grep {$severity eq $_} __make_list($param{severity});
444 next if exists $param{status} and not grep {$status eq $_} __make_list($param{status});
445 if (exists $param{tag}) {
447 # either a normal tag, or a usertag must be set
448 $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
449 my @bug_tags = split ' ', $tags;
450 $bug_ok = 1 if grep {my $bug_tag = $_;
451 grep {$bug_tag eq $_} __make_list($param{tag});
455 # We do this last, because a function may be slow...
456 if (exists $param{function}) {
457 my @bug_tags = split ' ', $tags;
458 my @packages = splitpackages($pkg);
459 my $package = (@packages > 1)?\@packages:$packages[0];
461 $param{function}->(pkg => $package,
464 submitter => $submitter,
465 severity => $severity,
474 sub __handle_pkg_src_and_maint{
475 my %param = validate_with(params => \@_,
476 spec => {package => {type => SCALAR|ARRAYREF,
479 src => {type => SCALAR|ARRAYREF,
482 maint => {type => SCALAR|ARRAYREF,
489 my @packages = __make_list($param{package});
490 my $package_keys = @packages?1:0;
492 @packages{@packages} = (1) x @packages;
493 if (exists $param{src}) {
494 # We only want to increment the number of keys if there is
497 for my $package ((map { getsrcpkgs($_)} __make_list($param{src})),__make_list($param{src})) {
498 $packages{$package}++;
501 $package_keys += $key_inc;
503 if (exists $param{maint}) {
505 my $maint_rev = getmaintainers_reverse();
506 for my $package (map { exists $maint_rev->{$_}?@{$maint_rev->{$_}}:()}
507 __make_list($param{maint})) {
508 $packages{$package}++;
511 $package_keys += $key_inc;
513 return grep {$packages{$_} >= $package_keys} keys %packages;
517 # This private subroutine takes a scalar and turns it into a list;
518 # transforming arrayrefs into their contents along the way. It also
519 # turns undef into the empty list.
521 return map {defined $_?(ref($_) eq 'ARRAY'?@{$_}:$_):()} @_;