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);
51 use Debbugs::Packages qw(getsrcpkgs);
52 use Fcntl qw(O_RDONLY);
53 use MLDBM qw(DB_File Storable);
61 The following parameters can either be a single scalar or a reference
62 to an array. The parameters are ANDed together, and the elements of
63 arrayrefs are a parameter are ORed. Future versions of this may allow
64 for limited regular expressions, and/or more complex expressions.
68 =item package -- name of the binary package
70 =item src -- name of the source package
72 =item maint -- address of the maintainer
74 =item maintenc -- encoded address of the maintainer
76 =item submitter -- address of the submitter
78 =item severity -- severity of the bug
80 =item status -- status of the bug
84 =item owner -- owner of the bug
86 =item dist -- distribution (I don't know about this one yet)
88 =item bugs -- list of bugs to search within
90 =item function -- see description below
94 =head3 Special options
96 The following options are special options used to modulate how the
97 searches are performed.
101 =item archive -- whether to search archived bugs or normal bugs;
104 =item usertags -- set of usertags and the bugs they are applied to
109 =head3 Subsidiary routines
111 All subsidiary routines get passed exactly the same set of options as
112 get_bugs. If for some reason they are unable to handle the options
113 passed (for example, they don't have the right type of index for the
114 type of selection) they should die as early as possible. [Using
115 Params::Validate and/or die when files don't exist makes this fairly
118 This function will then immediately move on to the next subroutine,
119 giving it the same arguments.
123 This option allows you to provide an arbitrary function which will be
124 given the information in the index.db file. This will be super, super
125 slow, so only do this if there's no other way to write the search.
127 You'll be given a list (which you can turn into a hash) like the
130 (pkg => ['a','b'], # may be a scalar (most common)
133 submitter => 'boo@baz.com',
134 severity => 'serious',
135 tags => ['a','b','c'], # may be an empty arrayref
138 The function should return 1 if the bug should be included; 0 if the
144 my %param = validate_with(params => \@_,
145 spec => {package => {type => SCALAR|ARRAYREF,
148 src => {type => SCALAR|ARRAYREF,
151 maint => {type => SCALAR|ARRAYREF,
154 maintenc => {type => SCALAR|ARRAYREF,
157 submitter => {type => SCALAR|ARRAYREF,
160 severity => {type => SCALAR|ARRAYREF,
163 status => {type => SCALAR|ARRAYREF,
166 tag => {type => SCALAR|ARRAYREF,
169 owner => {type => SCALAR|ARRAYREF,
172 dist => {type => SCALAR|ARRAYREF,
175 function => {type => CODEREF,
178 bugs => {type => SCALAR|ARRAYREF,
181 archive => {type => BOOLEAN,
184 usertags => {type => HASHREF,
191 my %options = %param;
193 # A configuration option will set an array that we'll use here instead.
194 for my $routine (qw(Debbugs::Bugs::get_bugs_by_idx Debbugs::Bugs::get_bugs_flatfile)) {
195 my ($package) = $routine =~ m/^(.+)\:\:/;
196 eval "use $package;";
198 # We output errors here because using an invalid function
199 # in the configuration file isn't something that should
201 warn "use $package failed with $@";
204 @bugs = eval "${routine}(\%options)";
207 # We don't output errors here, because failure here
208 # via die may be a perfectly normal thing.
209 print STDERR "$@" if $DEBUG;
214 # If no one succeeded, die
221 =head2 get_bugs_by_idx
223 This routine uses the by-$index.idx indicies to try to speed up
230 my %param = validate_with(params => \@_,
231 spec => {package => {type => SCALAR|ARRAYREF,
234 submitter => {type => SCALAR|ARRAYREF,
237 severity => {type => SCALAR|ARRAYREF,
240 tag => {type => SCALAR|ARRAYREF,
243 archive => {type => BOOLEAN,
249 my $keys = keys %param - 1;
250 die "Need at least 1 key to search by" unless $keys;
251 my $arc = $params{archive} ? '-arc':''
253 for my $key (keys %param) {
255 $index = 'submitter-email' if $key eq 'submitter';
256 $index = "$config{spool_dir}/by-${index}${arc}.idx"
257 tie %idx, MLDBM => $index, O_RDONLY
258 or die "Unable to open $index $!";
259 for my $search (__make_list($param{$key})) {
260 next unless defined $idx{$search};
261 for my $bug (keys %{$idx{$search}}) {
262 # increment the number of searches that this bug matched
266 untie %idx or die 'Unable to untie %idx';
268 # Throw out results that do not match all of the search specifications
269 return map {$keys == $bugs{$bug}?($bug):()} keys %bugs;
273 =head2 get_bugs_flatfile
275 This is the fallback search routine. It should be able to complete all
276 searches. [Or at least, that's the idea.]
280 sub get_bugs_flatfile{
281 my %param = validate_with(params => \@_,
282 spec => {package => {type => SCALAR|ARRAYREF,
285 src => {type => SCALAR|ARRAYREF,
288 maint => {type => SCALAR|ARRAYREF,
291 maintenc => {type => SCALAR|ARRAYREF,
294 submitter => {type => SCALAR|ARRAYREF,
297 severity => {type => SCALAR|ARRAYREF,
300 status => {type => SCALAR|ARRAYREF,
303 tag => {type => SCALAR|ARRAYREF,
307 # owner => {type => SCALAR|ARRAYREF,
310 # dist => {type => SCALAR|ARRAYREF,
313 archive => {type => BOOLEAN,
316 usertags => {type => HASHREF,
319 function => {type => CODEREF,
325 if ($param{archive}) {
326 $flatfile = new IO::File "$debbugs::gSpoolDir/index.archive", 'r'
327 or die "Unable to open $debbugs::gSpoolDir/index.archive for reading: $!";
330 $flatfile = new IO::File "$debbugs::gSpoolDir/index.db", 'r'
331 or die "Unable to open $debbugs::gSpoolDir/index.db for reading: $!";
334 if (exists $param{tag} and exists $param{usertags}) {
336 # This complex slice makes a hash with the bugs which have the
337 # usertags passed in $param{tag} set.
338 @usertag_bugs{map {@{$_}}
339 @{$param{usertags}}{__make_list($param{tag})}
340 } = (1) x @{$param{usertags}}{__make_list($param{tag})}
343 while (<$flatfile>) {
344 next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
345 my ($pkg,$bug,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
346 next if exists $param{bug} and not grep {$bug == $_} __make_list($param{bugs});
347 if (exists $param{pkg}) {
348 my @packages = splitpackages($pkg);
349 next unless grep { my $pkg_list = $_;
350 grep {$pkg_list eq $_} __make_list($param{pkg})
353 if (exists $param{src}) {
354 my @src_packages = map { getsrcpkgs($_)} __make_list($param{src});
355 my @packages = splitpackages($pkg);
356 next unless grep { my $pkg_list = $_;
357 grep {$pkg_list eq $_} @packages
360 if (exists $param{submitter}) {
361 my @p_addrs = map {$_->address}
362 map {lc(getparsedaddrs($_))}
363 __make_list($param{submitter});
364 my @f_addrs = map {$_->address}
365 getparsedaddrs($submitter||'');
366 next unless grep { my $f_addr = $_;
367 grep {$f_addr eq $_} @p_addrs
370 next if exists $param{severity} and not grep {$severity eq $_} __make_list($param{severity});
371 next if exists $param{status} and not grep {$status eq $_} __make_list($param{status});
372 if (exists $param{tag}) {
374 # either a normal tag, or a usertag must be set
375 $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
376 my @bug_tags = split ' ', $tags;
377 $bug_ok = 1 if grep {my $bug_tag = $_;
378 grep {$bug_tag eq $_} __make_list($param{tag});
382 # We do this last, because a function may be slow...
383 if (exists $param{function}) {
384 my @bug_tags = split ' ', $tags;
385 my @packages = splitpackages($pkg);
386 my $package = (@packages > 1)?\@packages:$packages[0],
388 $param{function}->(pkg => $package,
391 submitter => $submitter,
392 severity => $severity,
402 # This private subroutine takes a scalar and turns it
403 # into a list; transforming arrayrefs into their contents
406 return map {ref($_) eq 'ARRAY'?@{$_}:$_} @_;