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 owner => {type => SCALAR|ARRAYREF,
245 src => {type => SCALAR|ARRAYREF,
248 maint => {type => SCALAR|ARRAYREF,
255 # We handle src packages, maint and maintenc by mapping to the
256 # appropriate binary packages, then removing all packages which
257 # don't match all queries
258 my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
259 qw(package src maint)
261 if (exists $param{package} or
262 exists $param{src} or
263 exists $param{maint}) {
264 delete @param{qw(maint src)};
265 $param{package} = [@packages];
267 my $keys = keys(%param) - 1;
268 die "Need at least 1 key to search by" unless $keys;
269 my $arc = $param{archive} ? '-arc':'';
271 for my $key (grep {$_ ne 'archive'} keys %param) {
273 $index = 'submitter-email' if $key eq 'submitter';
274 $index = "$config{spool_dir}/by-${index}${arc}.idx";
275 tie(%idx, MLDBM => $index, O_RDONLY)
276 or die "Unable to open $index: $!";
277 for my $search (__make_list($param{$key})) {
278 next unless defined $idx{$search};
279 for my $bug (keys %{$idx{$search}}) {
280 # increment the number of searches that this bug matched
284 untie %idx or die 'Unable to untie %idx';
286 # Throw out results that do not match all of the search specifications
287 return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
291 =head2 get_bugs_flatfile
293 This is the fallback search routine. It should be able to complete all
294 searches. [Or at least, that's the idea.]
298 sub get_bugs_flatfile{
299 my %param = validate_with(params => \@_,
300 spec => {package => {type => SCALAR|ARRAYREF,
303 src => {type => SCALAR|ARRAYREF,
306 maint => {type => SCALAR|ARRAYREF,
309 submitter => {type => SCALAR|ARRAYREF,
312 severity => {type => SCALAR|ARRAYREF,
315 status => {type => SCALAR|ARRAYREF,
318 tag => {type => SCALAR|ARRAYREF,
322 # owner => {type => SCALAR|ARRAYREF,
325 # dist => {type => SCALAR|ARRAYREF,
328 archive => {type => BOOLEAN,
331 usertags => {type => HASHREF,
334 function => {type => CODEREF,
340 if ($param{archive}) {
341 $flatfile = new IO::File "$debbugs::gSpoolDir/index.archive", 'r'
342 or die "Unable to open $debbugs::gSpoolDir/index.archive for reading: $!";
345 $flatfile = new IO::File "$debbugs::gSpoolDir/index.db", 'r'
346 or die "Unable to open $debbugs::gSpoolDir/index.db for reading: $!";
349 if (exists $param{tag} and exists $param{usertags}) {
351 # This complex slice makes a hash with the bugs which have the
352 # usertags passed in $param{tag} set.
353 @usertag_bugs{map {@{$_}}
354 @{$param{usertags}}{__make_list($param{tag})}
355 } = (1) x @{$param{usertags}}{__make_list($param{tag})}
357 # We handle src packages, maint and maintenc by mapping to the
358 # appropriate binary packages, then removing all packages which
359 # don't match all queries
360 my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
361 qw(package src maint)
363 if (exists $param{package} or
364 exists $param{src} or
365 exists $param{maint}) {
366 delete @param{qw(maint src)};
367 $param{package} = [@packages];
370 while (<$flatfile>) {
371 next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
372 my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
373 next if exists $param{bug} and not grep {$bug == $_} __make_list($param{bugs});
374 if (exists $param{pkg}) {
375 my @packages = splitpackages($pkg);
376 next unless grep { my $pkg_list = $_;
377 grep {$pkg_list eq $_} __make_list($param{pkg})
380 if (exists $param{src}) {
381 my @src_packages = map { getsrcpkgs($_)} __make_list($param{src});
382 my @packages = splitpackages($pkg);
383 next unless grep { my $pkg_list = $_;
384 grep {$pkg_list eq $_} @packages
387 if (exists $param{submitter}) {
388 my @p_addrs = map {lc($_->address)}
389 map {getparsedaddrs($_)}
390 __make_list($param{submitter});
391 my @f_addrs = map {$_->address}
392 getparsedaddrs($submitter||'');
393 next unless grep { my $f_addr = $_;
394 grep {$f_addr eq $_} @p_addrs
397 next if exists $param{severity} and not grep {$severity eq $_} __make_list($param{severity});
398 next if exists $param{status} and not grep {$status eq $_} __make_list($param{status});
399 if (exists $param{tag}) {
401 # either a normal tag, or a usertag must be set
402 $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
403 my @bug_tags = split ' ', $tags;
404 $bug_ok = 1 if grep {my $bug_tag = $_;
405 grep {$bug_tag eq $_} __make_list($param{tag});
409 # We do this last, because a function may be slow...
410 if (exists $param{function}) {
411 my @bug_tags = split ' ', $tags;
412 my @packages = splitpackages($pkg);
413 my $package = (@packages > 1)?\@packages:$packages[0];
415 $param{function}->(pkg => $package,
418 submitter => $submitter,
419 severity => $severity,
428 sub __handle_pkg_src_and_maint{
429 my %param = validate_with(params => \@_,
430 spec => {package => {type => SCALAR|ARRAYREF,
433 src => {type => SCALAR|ARRAYREF,
436 maint => {type => SCALAR|ARRAYREF,
443 my @packages = __make_list($param{package});
444 my $package_keys = @packages?1:0;
446 @packages{@packages} = (1) x @packages;
447 if (exists $param{src}) {
448 # We only want to increment the number of keys if there is
451 for my $package ((map { getsrcpkgs($_)} __make_list($param{src})),__make_list($param{src})) {
452 $packages{$package}++;
455 $package_keys += $key_inc;
457 if (exists $param{maint}) {
459 my $maint_rev = getmaintainers_reverse();
460 for my $package (map { exists $maint_rev->{$_}?@{$maint_rev->{$_}}:()}
461 __make_list($param{maint})) {
462 $packages{$package}++;
465 $package_keys += $key_inc;
467 return grep {$packages{$_} >= $package_keys} keys %packages;
471 # This private subroutine takes a scalar and turns it into a list;
472 # transforming arrayrefs into their contents along the way. It also
473 # turns undef into the empty list.
475 return map {defined $_?(ref($_) eq 'ARRAY'?@{$_}:$_):()} @_;