]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/Bugs.pm
add cache_key support to binary_to_source when schema is set
[debbugs.git] / Debbugs / Bugs.pm
1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
5 #
6 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
7
8 package Debbugs::Bugs;
9
10 =head1 NAME
11
12 Debbugs::Bugs -- Bug selection routines for debbugs
13
14 =head1 SYNOPSIS
15
16 use Debbugs::Bugs qw(get_bugs);
17
18
19 =head1 DESCRIPTION
20
21 This module is a replacement for all of the various methods of
22 selecting different types of bugs.
23
24 It implements a single function, get_bugs, which defines the master
25 interface for selecting bugs.
26
27 It attempts to use subsidiary functions to actually do the selection,
28 in the order specified in the configuration files. [Unless you're
29 insane, they should be in order from fastest (and often most
30 incomplete) to slowest (and most complete).]
31
32 =head1 BUGS
33
34 =head1 FUNCTIONS
35
36 =cut
37
38 use warnings;
39 use strict;
40 use feature 'state';
41 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
42 use Exporter qw(import);
43
44 BEGIN{
45      $VERSION = 1.00;
46      $DEBUG = 0 unless defined $DEBUG;
47
48      @EXPORT = ();
49      %EXPORT_TAGS = ();
50      @EXPORT_OK = (qw(get_bugs count_bugs newest_bug bug_filter));
51      $EXPORT_TAGS{all} = [@EXPORT_OK];
52 }
53
54 use Debbugs::Config qw(:config);
55 use Params::Validate qw(validate_with :types);
56 use IO::File;
57 use Debbugs::Status qw(splitpackages get_bug_status);
58 use Debbugs::Packages qw(getsrcpkgs getpkgsrc);
59 use Debbugs::Common qw(getparsedaddrs package_maintainer getmaintainers make_list hash_slice);
60 use Fcntl qw(O_RDONLY);
61 use MLDBM qw(DB_File Storable);
62 use List::AllUtils qw(first max);
63 use Carp;
64
65 =head2 get_bugs
66
67      get_bugs()
68
69 =head3 Parameters
70
71 The following parameters can either be a single scalar or a reference
72 to an array. The parameters are ANDed together, and the elements of
73 arrayrefs are a parameter are ORed. Future versions of this may allow
74 for limited regular expressions, and/or more complex expressions.
75
76 =over
77
78 =item package -- name of the binary package
79
80 =item src -- name of the source package
81
82 =item maint -- address of the maintainer
83
84 =item submitter -- address of the submitter
85
86 =item severity -- severity of the bug
87
88 =item status -- status of the bug
89
90 =item tag -- bug tags
91
92 =item owner -- owner of the bug
93
94 =item correspondent -- address of someone who sent mail to the log
95
96 =item affects -- bugs which affect this package
97
98 =item dist -- distribution (I don't know about this one yet)
99
100 =item bugs -- list of bugs to search within
101
102 =item function -- see description below
103
104 =back
105
106 =head3 Special options
107
108 The following options are special options used to modulate how the
109 searches are performed.
110
111 =over
112
113 =item archive -- whether to search archived bugs or normal bugs;
114 defaults to false. As a special case, if archive is 'both', but
115 archived and unarchived bugs are returned.
116
117 =item usertags -- set of usertags and the bugs they are applied to
118
119 =back
120
121
122 =head3 Subsidiary routines
123
124 All subsidiary routines get passed exactly the same set of options as
125 get_bugs. If for some reason they are unable to handle the options
126 passed (for example, they don't have the right type of index for the
127 type of selection) they should die as early as possible. [Using
128 Params::Validate and/or die when files don't exist makes this fairly
129 trivial.]
130
131 This function will then immediately move on to the next subroutine,
132 giving it the same arguments.
133
134 =head3 function
135
136 This option allows you to provide an arbitrary function which will be
137 given the information in the index.db file. This will be super, super
138 slow, so only do this if there's no other way to write the search.
139
140 You'll be given a list (which you can turn into a hash) like the
141 following:
142
143  (pkg => ['a','b'], # may be a scalar (most common)
144   bug => 1234,
145   status => 'pending',
146   submitter => 'boo@baz.com',
147   severity => 'serious',
148   tags => ['a','b','c'], # may be an empty arrayref
149  )
150
151 The function should return 1 if the bug should be included; 0 if the
152 bug should not.
153
154 =cut
155
156 state $_non_search_key_regex = qr/^(bugs|archive|usertags|schema)$/;
157
158 my %_get_bugs_common_options =
159     (package   => {type => SCALAR|ARRAYREF,
160                    optional => 1,
161                   },
162      src       => {type => SCALAR|ARRAYREF,
163                    optional => 1,
164                   },
165      maint     => {type => SCALAR|ARRAYREF,
166                    optional => 1,
167                   },
168      submitter => {type => SCALAR|ARRAYREF,
169                    optional => 1,
170                   },
171      severity  => {type => SCALAR|ARRAYREF,
172                    optional => 1,
173                   },
174      status    => {type => SCALAR|ARRAYREF,
175                    optional => 1,
176                   },
177      tag       => {type => SCALAR|ARRAYREF,
178                    optional => 1,
179                   },
180      owner     => {type => SCALAR|ARRAYREF,
181                    optional => 1,
182                   },
183      dist      => {type => SCALAR|ARRAYREF,
184                    optional => 1,
185                   },
186      correspondent => {type => SCALAR|ARRAYREF,
187                        optional => 1,
188                       },
189      affects   => {type => SCALAR|ARRAYREF,
190                    optional => 1,
191                   },
192      function  => {type => CODEREF,
193                    optional => 1,
194                   },
195      bugs      => {type => SCALAR|ARRAYREF,
196                    optional => 1,
197                   },
198      archive   => {type => BOOLEAN|SCALAR,
199                    default => 0,
200                   },
201      usertags  => {type => HASHREF,
202                    optional => 1,
203                   },
204      newest    => {type => SCALAR|ARRAYREF,
205                    optional => 1,
206                   },
207      schema => {type     => OBJECT,
208                 optional => 1,
209                },
210     );
211
212
213 state $_get_bugs_options = {%_get_bugs_common_options};
214 sub get_bugs{
215      my %param = validate_with(params => \@_,
216                                spec   => $_get_bugs_options,
217                               );
218
219      # Normalize options
220      my %options = %param;
221      my @bugs;
222      if ($options{archive} eq 'both') {
223           push @bugs, get_bugs(%options,archive=>0);
224           push @bugs, get_bugs(%options,archive=>1);
225           my %bugs;
226           @bugs{@bugs} = @bugs;
227           return keys %bugs;
228      }
229      # A configuration option will set an array that we'll use here instead.
230      for my $routine (qw(Debbugs::Bugs::get_bugs_by_db Debbugs::Bugs::get_bugs_by_idx Debbugs::Bugs::get_bugs_flatfile)) {
231           my ($package) = $routine =~ m/^(.+)\:\:/;
232           eval "use $package;";
233           if ($@) {
234                # We output errors here because using an invalid function
235                # in the configuration file isn't something that should
236                # be done.
237                warn "use $package failed with $@";
238                next;
239           }
240           @bugs = eval "${routine}(\%options)";
241           if ($@) {
242
243                # We don't output errors here, because failure here
244                # via die may be a perfectly normal thing.
245                print STDERR "$@" if $DEBUG;
246                next;
247           }
248           last;
249      }
250      # If no one succeeded, die
251      if ($@) {
252           die "$@";
253      }
254      return @bugs;
255 }
256
257 =head2 count_bugs
258
259      count_bugs(function => sub {...})
260
261 Uses a subroutine to classify bugs into categories and return the
262 number of bugs which fall into those categories
263
264 =cut
265
266 sub count_bugs {
267      my %param = validate_with(params => \@_,
268                                spec   => {function => {type => CODEREF,
269                                                       },
270                                           archive  => {type => BOOLEAN,
271                                                        default => 0,
272                                                       },
273                                          },
274                               );
275      my $flatfile;
276      if ($param{archive}) {
277           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
278                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
279      }
280      else {
281           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
282                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
283      }
284      my %count = ();
285      while(<$flatfile>) {
286           if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) {
287                my @x = $param{function}->(pkg       => $1,
288                                           bug       => $2,
289                                           status    => $4,
290                                           submitter => $5,
291                                           severity  => $6,
292                                           tags      => $7,
293                                          );
294                local $_;
295                $count{$_}++ foreach @x;
296           }
297      }
298      close $flatfile;
299      return %count;
300 }
301
302 =head2 newest_bug
303
304      my $bug = newest_bug();
305
306 Returns the bug number of the newest bug, which is nextnumber-1.
307
308 =cut
309
310 sub newest_bug {
311      my $nn_fh = IO::File->new("$config{spool_dir}/nextnumber",'r')
312           or die "Unable to open $config{spool_dir}nextnumber for reading: $!";
313      local $/;
314      my $next_number = <$nn_fh>;
315      close $nn_fh;
316      chomp $next_number;
317      return $next_number-1;
318 }
319
320 =head2 bug_filter
321
322      bug_filter
323
324 Allows filtering bugs on commonly used criteria
325
326
327
328 =cut
329
330 sub bug_filter {
331      my %param = validate_with(params => \@_,
332                                spec   => {bug    => {type => ARRAYREF|SCALAR,
333                                                      optional => 1,
334                                                     },
335                                           status => {type => HASHREF|ARRAYREF,
336                                                      optional => 1,
337                                                     },
338                                           seen_merged => {type => HASHREF,
339                                                           optional => 1,
340                                                          },
341                                           repeat_merged => {type => BOOLEAN,
342                                                             default => 1,
343                                                            },
344                                           include => {type => HASHREF,
345                                                       optional => 1,
346                                                      },
347                                           exclude => {type => HASHREF,
348                                                       optional => 1,
349                                                      },
350                                           min_days => {type => SCALAR,
351                                                        optional => 1,
352                                                       },
353                                           max_days => {type => SCALAR,
354                                                        optional => 1,
355                                                       },
356                                          },
357                               );
358      if (exists $param{repeat_merged} and
359          not $param{repeat_merged} and
360          not defined $param{seen_merged}) {
361           croak "repeat_merged false requires seen_merged to be passed";
362      }
363      if (not exists $param{bug} and not exists $param{status}) {
364          croak "one of bug or status must be passed";
365      }
366
367      if (not exists $param{status}) {
368           my $location = getbuglocation($param{bug}, 'summary');
369           return 0 if not defined $location or not length $location;
370           $param{status} = readbug( $param{bug}, $location );
371           return 0 if not defined $param{status};
372      }
373
374      if (exists $param{include}) {
375           return 1 if (!__bug_matches($param{include}, $param{status}));
376      }
377      if (exists $param{exclude}) {
378           return 1 if (__bug_matches($param{exclude}, $param{status}));
379      }
380      if (exists $param{repeat_merged} and not $param{repeat_merged}) {
381           my @merged = sort {$a<=>$b} $param{bug}, split(/ /, $param{status}{mergedwith});
382           return 1 if first {defined $_} @{$param{seen_merged}}{@merged};
383           @{$param{seen_merged}}{@merged} = (1) x @merged;
384      }
385      my $daysold = int((time - $param{status}{date}) / 86400);   # seconds to days
386      if (exists $param{min_days}) {
387           return 1 unless $param{min_days} <= $daysold;
388      }
389      if (exists $param{max_days}) {
390           return 1 unless $param{max_days} == -1 or
391                $param{max_days} >= $daysold;
392      }
393      return 0;
394 }
395
396
397 =head2 get_bugs_by_idx
398
399 This routine uses the by-$index.idx indicies to try to speed up
400 searches.
401
402
403 =cut
404
405
406 state $_get_bugs_by_idx_options =
407    {hash_slice(%_get_bugs_common_options,
408                (qw(package submitter severity tag archive),
409                 qw(owner src maint bugs correspondent),
410                 qw(affects usertags newest))
411               )
412    };
413 sub get_bugs_by_idx{
414      my %param = validate_with(params => \@_,
415                                spec   => $_get_bugs_by_idx_options
416                               );
417      my %bugs = ();
418
419      # If we're given an empty maint (unmaintained packages), we can't
420      # handle it, so bail out here
421      for my $maint (make_list(exists $param{maint}?$param{maint}:[])) {
422           if (defined $maint and $maint eq '') {
423                die "Can't handle empty maint (unmaintained packages) in get_bugs_by_idx";
424           }
425      }
426      if ($param{newest}) {
427          my $newest_bug = newest_bug();
428          my @bugs = ($newest_bug - max(make_list($param{newest})) + 1) .. $newest_bug;
429          $param{bugs} = [exists $param{bugs}?make_list($param{bugs}):(),
430                          @bugs,
431                         ];
432      }
433      # We handle src packages, maint and maintenc by mapping to the
434      # appropriate binary packages, then removing all packages which
435      # don't match all queries
436      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
437                                                qw(package src maint)
438                                               );
439      if (exists $param{package} or
440          exists $param{src} or
441          exists $param{maint}) {
442           delete @param{qw(maint src)};
443           $param{package} = [@packages];
444      }
445      my $keys = grep {$_ !~ $_non_search_key_regex} keys(%param);
446      die "Need at least 1 key to search by" unless $keys;
447      my $arc = $param{archive} ? '-arc':'';
448      my %idx;
449      for my $key (grep {$_ !~ $_non_search_key_regex} keys %param) {
450           my $index = $key;
451           $index = 'submitter-email' if $key eq 'submitter';
452           $index = "$config{spool_dir}/by-${index}${arc}.idx";
453           tie(%idx, MLDBM => $index, O_RDONLY)
454                or die "Unable to open $index: $!";
455           my %bug_matching = ();
456           for my $search (make_list($param{$key})) {
457                for my $bug (keys %{$idx{$search}||{}}) {
458                     next if $bug_matching{$bug};
459                     # increment the number of searches that this bug matched
460                     $bugs{$bug}++;
461                     $bug_matching{$bug}=1;
462                }
463                if ($search ne lc($search)) {
464                     for my $bug (keys %{$idx{lc($search)}||{}}) {
465                          next if $bug_matching{$bug};
466                          # increment the number of searches that this bug matched
467                          $bugs{$bug}++;
468                          $bug_matching{$bug}=1;
469                     }
470                }
471           }
472           if ($key eq 'tag' and exists $param{usertags}) {
473                for my $bug (make_list(grep {defined $_ } @{$param{usertags}}{make_list($param{tag})})) {
474                     next if $bug_matching{$bug};
475                     $bugs{$bug}++;
476                     $bug_matching{$bug}=1;
477                }
478           }
479           untie %idx or die 'Unable to untie %idx';
480      }
481      if ($param{bugs}) {
482           $keys++;
483           for my $bug (make_list($param{bugs})) {
484                $bugs{$bug}++;
485           }
486      }
487      # Throw out results that do not match all of the search specifications
488      return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
489 }
490
491
492 =head2 get_bugs_by_db
493
494 This routine uses the database to try to speed up
495 searches.
496
497
498 =cut
499
500 state $_get_bugs_by_db_options =
501    {hash_slice(%_get_bugs_common_options,
502                (qw(package submitter severity tag archive),
503                 qw(owner src maint bugs correspondent),
504                 qw(affects usertags newest))
505               ),
506     schema => {type     => OBJECT,
507               },
508    };
509 sub get_bugs_by_db{
510      my %param = validate_with(params => \@_,
511                                spec   => $_get_bugs_by_db_options,
512                               );
513      my %bugs = ();
514
515      my $s = $param{schema};
516      my $keys = grep {$_ !~ $_non_search_key_regex} keys(%param);
517      die "Need at least 1 key to search by" unless $keys;
518      my $rs = $s->resultset('Bug');
519      if (exists $param{severity}) {
520          $rs = $rs->search({'severity.severity' =>
521                             [make_list($param{severity})],
522                            },
523                           {join => 'severity'},
524                           );
525      }
526      for my $key (qw(owner submitter done)) {
527          if (exists $param{$key}) {
528              $rs = $rs->search({"${key}.addr" =>
529                                 [make_list($param{$key})],
530                                },
531                               {join => $key},
532                               );
533          }
534      }
535      if (exists $param{newest}) {
536          $rs =
537              $rs->search({},
538                         {order_by => {-desc => 'me.creation'},
539                          rows => max(make_list($param{newest})),
540                         },
541                         );
542      }
543      if (exists $param{correspondent}) {
544          my $message_rs =
545              $s->resultset('Message')->
546              search({'correspondent.addr' =>
547                      [make_list($param{correspondent})],
548                     },
549                    {join => {message_correspondents => 'correspondent'},
550                     columns => ['id'],
551                     group_by => ['me.id'],
552                    },
553                    );
554          $rs = $rs->search({'bug_messages.message' =>
555                            {-in => $message_rs->get_column('id')->as_query()},
556                            },
557                           {join => 'bug_messages',
558                           },
559                           );
560      }
561      if (exists $param{affects}) {
562          my @aff_list = make_list($param{affects});
563          s/^src:// foreach @aff_list;
564          $rs = $rs->search({-or => {'bin_pkg.pkg' =>
565                                     [@aff_list],
566                                     'src_pkg.pkg' =>
567                                     [@aff_list],
568                                     'me.unknown_affects' =>
569                                     [@aff_list]
570                                    },
571                            },
572                           {join => [{bug_affects_binpackages => 'bin_pkg'},
573                                    {bug_affects_srcpackages => 'src_pkg'},
574                                    ],
575                           },
576                           );
577      }
578      if (exists $param{package}) {
579          $rs = $rs->search({-or => {'bin_pkg.pkg' =>
580                                     [make_list($param{package})],
581                                     'me.unknown_packages' =>
582                                     [make_list($param{package})]},
583                            },
584                           {join => {bug_binpackages => 'bin_pkg'}});
585      }
586      if (exists $param{maint}) {
587          my @maint_list =
588              map {$_ eq '' ? undef : $_}
589              make_list($param{maint});
590          my $bin_pkgs_rs =
591              $s->resultset('BinPkg')->
592              search({'correspondent.addr' => [@maint_list]},
593                    {join => {bin_vers =>
594                             {src_ver =>
595                             {maintainer => 'correspondent'}}},
596                     columns => ['id'],
597                     group_by => ['me.id'],
598                    },
599                    );
600          my $src_pkgs_rs =
601              $s->resultset('SrcPkg')->
602              search({'correspondent.addr' => [@maint_list]},
603                    {join => {src_vers =>
604                             {maintainer => 'correspondent'}},
605                     columns => ['id'],
606                     group_by => ['me.id'],
607                    },
608                    );
609          $rs = $rs->search({-or => {'bug_binpackages.bin_pkg' =>
610                                    { -in => $bin_pkgs_rs->get_column('id')->as_query},
611                                     'bug_srcpackages.src_pkg' => 
612                                    { -in => $src_pkgs_rs->get_column('id')->as_query},
613                                    },
614                            },
615                           {join => ['bug_binpackages',
616                                     'bug_srcpackages',
617                                    ]}
618                           );
619      }
620      if (exists $param{src}) {
621          # identify all of the srcpackages and binpackages that match first
622          my $src_pkgs_rs =
623          $s->resultset('SrcPkg')->
624              search({-or => [map {('me.pkg' => $_,
625                                   )}
626                              make_list($param{src})],
627                     },
628                    { columns => ['id'],
629                      group_by => ['me.id'],
630                     },
631                    );
632          my $bin_pkgs_rs =
633          $s->resultset('BinPkg')->
634              search({-or => [map {('src_pkg.pkg' => $_,
635                                   )}
636                              make_list($param{src})],
637                      },
638                    {join => {bin_vers => {src_ver => 'src_pkg'}},
639                     columns => ['id'],
640                     group_by => ['me.id'],
641                    });
642          $rs = $rs->search({-or => {'bug_binpackages.bin_pkg' =>
643                                    { -in => $bin_pkgs_rs->get_column('id')->as_query},
644                                     'bug_srcpackages.src_pkg' =>
645                                    { -in => $src_pkgs_rs->get_column('id')->as_query},
646                                     'me.unknown_packages' =>
647                                     [make_list($param{src})],
648                                    },
649                            },
650                           {join => ['bug_binpackages',
651                                     'bug_srcpackages',
652                                    ]}
653                           );
654      }
655      # tags are very odd, because we must handle usertags.
656      if (exists $param{tag}) {
657          # bugs from usertags which matter
658          my %bugs_matching_usertags;
659          for my $bug (make_list(grep {defined $_ }
660                                 @{$param{usertags}}{make_list($param{tag})})) {
661              $bugs_matching_usertags{$bug} = 1;
662          }
663          # we want all bugs which either match the tag name given in
664          # param, or have a usertag set which matches one of the tag
665          # names given in param.
666          $rs = $rs->search({-or => {map {('tag.tag' => $_)}
667                                     make_list($param{tag}),
668                                     map {('me.id' => $_)}
669                                     keys %bugs_matching_usertags
670                                    },
671                            },
672                           {join => {bug_tags => 'tag'}});
673      }
674      if (exists $param{bugs}) {
675          $rs = $rs->search({-or => {map {('me.id' => $_)}
676                                     make_list($param{bugs})}
677                            });
678      }
679      # handle archive
680      if (defined $param{archive} and $param{archive} ne 'both') {
681          $rs = $rs->search({'me.archived' => $param{archive}});
682      }
683      return $rs->get_column('id')->all();
684 }
685
686
687 =head2 get_bugs_flatfile
688
689 This is the fallback search routine. It should be able to complete all
690 searches. [Or at least, that's the idea.]
691
692 =cut
693
694 state $_get_bugs_flatfile_options =
695    {hash_slice(%_get_bugs_common_options,
696                map {$_ eq 'dist'?():($_)} keys %_get_bugs_common_options
697               )
698    };
699
700 sub get_bugs_flatfile{
701      my %param = validate_with(params => \@_,
702                                spec   => $_get_bugs_flatfile_options
703                               );
704      my $flatfile;
705      if ($param{newest}) {
706          my $newest_bug = newest_bug();
707          my @bugs = ($newest_bug - max(make_list($param{newest})) + 1) .. $newest_bug;
708          $param{bugs} = [exists $param{bugs}?make_list($param{bugs}):(),
709                          @bugs,
710                         ];
711      }
712      if ($param{archive}) {
713           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
714                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
715      }
716      else {
717           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
718                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
719      }
720      my %usertag_bugs;
721      if (exists $param{tag} and exists $param{usertags}) {
722           # This complex slice makes a hash with the bugs which have the
723           # usertags passed in $param{tag} set.
724           @usertag_bugs{make_list(@{$param{usertags}}{make_list($param{tag})})
725                         } = (1) x make_list(@{$param{usertags}}{make_list($param{tag})});
726      }
727      my $unmaintained_packages = 0;
728      # unmaintained packages is a special case
729      my @maints = make_list(exists $param{maint}?$param{maint}:[]);
730      $param{maint} = [];
731      for my $maint (@maints) {
732           if (defined $maint and $maint eq '' and not $unmaintained_packages) {
733                $unmaintained_packages = 1;
734                our %maintainers = %{getmaintainers()};
735                $param{function} = [(exists $param{function}?
736                                     (ref $param{function}?@{$param{function}}:$param{function}):()),
737                                    sub {my %d=@_;
738                                         foreach my $try (make_list($d{"pkg"})) {
739                                              next unless length $try;
740                                              ($try) = $try =~ m/^(?:src:)?(.+)/;
741                                              return 1 if not exists $maintainers{$try};
742                                         }
743                                         return 0;
744                                    }
745                                   ];
746           }
747           elsif (defined $maint and $maint ne '') {
748                push @{$param{maint}},$maint;
749           }
750      }
751      # We handle src packages, maint and maintenc by mapping to the
752      # appropriate binary packages, then removing all packages which
753      # don't match all queries
754      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
755                                                qw(package src maint)
756                                               );
757      if (exists $param{package} or
758          exists $param{src} or
759          exists $param{maint}) {
760           delete @param{qw(maint src)};
761           $param{package} = [@packages] if @packages;
762      }
763      my $grep_bugs = 0;
764      my %bugs;
765      if (exists $param{bugs}) {
766           $bugs{$_} = 1 for make_list($param{bugs});
767           $grep_bugs = 1;
768      }
769      # These queries have to be handled by get_bugs_by_idx
770      if (exists $param{owner}
771          or exists $param{correspondent}
772          or exists $param{affects}) {
773           $bugs{$_} = 1 for get_bugs_by_idx(map {exists $param{$_}?($_,$param{$_}):()}
774                                             qw(owner correspondent affects),
775                                            );
776           $grep_bugs = 1;
777      }
778      my @bugs;
779      BUG: while (<$flatfile>) {
780           next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*(.*)\s*\]\s+(\w+)\s+(.*)$/;
781           my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
782           next if $grep_bugs and not exists $bugs{$bug};
783           if (exists $param{package}) {
784                my @packages = splitpackages($pkg);
785                next unless grep { my $pkg_list = $_;
786                                   grep {$pkg_list eq $_} make_list($param{package})
787                              } @packages;
788           }
789           if (exists $param{src}) {
790                my @src_packages = map { getsrcpkgs($_)} make_list($param{src});
791                my @packages = splitpackages($pkg);
792                next unless grep { my $pkg_list = $_;
793                                   grep {$pkg_list eq $_} @packages
794                              } @src_packages;
795           }
796           if (exists $param{submitter}) {
797                my @p_addrs = map {lc($_->address)}
798                     map {getparsedaddrs($_)}
799                          make_list($param{submitter});
800                my @f_addrs = map {$_->address}
801                     getparsedaddrs($submitter||'');
802                next unless grep { my $f_addr = $_; 
803                                   grep {$f_addr eq $_} @p_addrs
804                              } @f_addrs;
805           }
806           next if exists $param{severity} and not grep {$severity eq $_} make_list($param{severity});
807           next if exists $param{status} and not grep {$status eq $_} make_list($param{status});
808           if (exists $param{tag}) {
809                my $bug_ok = 0;
810                # either a normal tag, or a usertag must be set
811                $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
812                my @bug_tags = split ' ', $tags;
813                $bug_ok = 1 if grep {my $bug_tag = $_;
814                                     grep {$bug_tag eq $_} make_list($param{tag});
815                                } @bug_tags;
816                next unless $bug_ok;
817           }
818           # We do this last, because a function may be slow...
819           if (exists $param{function}) {
820                my @bug_tags = split ' ', $tags;
821                my @packages = splitpackages($pkg);
822                my $package = (@packages > 1)?\@packages:$packages[0];
823                for my $function (make_list($param{function})) {
824                     next BUG unless
825                          $function->(pkg       => $package,
826                                      bug       => $bug,
827                                      status    => $status,
828                                      submitter => $submitter,
829                                      severity  => $severity,
830                                      tags      => \@bug_tags,
831                                     );
832                }
833           }
834           push @bugs, $bug;
835      }
836      return @bugs;
837 }
838
839 =head1 PRIVATE FUNCTIONS
840
841 =head2 __handle_pkg_src_and_maint
842
843      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
844                                                qw(package src maint)
845                                               );
846
847 Turn package/src/maint into a list of packages
848
849 =cut
850
851 sub __handle_pkg_src_and_maint{
852      my %param = validate_with(params => \@_,
853                                spec   => {package   => {type => SCALAR|ARRAYREF,
854                                                         optional => 1,
855                                                        },
856                                           src       => {type => SCALAR|ARRAYREF,
857                                                         optional => 1,
858                                                        },
859                                           maint     => {type => SCALAR|ARRAYREF,
860                                                         optional => 1,
861                                                        },
862                                          },
863                                allow_extra => 1,
864                               );
865
866      my @packages;
867      @packages = make_list($param{package}) if exists $param{package};
868      my $package_keys = @packages?1:0;
869      my %packages;
870      @packages{@packages} = (1) x @packages;
871      if (exists $param{src}) {
872           # We only want to increment the number of keys if there is
873           # something to match
874           my $key_inc = 0;
875           # in case there are binaries with the same name as the
876           # source
877           my %_temp_p = ();
878           for my $package ((map {getsrcpkgs($_)} make_list($param{src}))) {
879                $packages{$package}++ unless exists $_temp_p{$package};
880                $_temp_p{$package} = 1;
881                $key_inc=1;
882           }
883           for my $package (make_list($param{src})) {
884                $packages{"src:$package"}++ unless exists $_temp_p{"src:$package"};
885                $_temp_p{"src:$package"} = 1;
886                $key_inc=1;
887                # As a temporary hack, we will also include $param{src}
888                # in this list for packages passed which do not have a
889                # corresponding binary package
890                if (not exists getpkgsrc()->{$package}) {
891                    $packages{$package}++ unless exists $_temp_p{$package};
892                    $_temp_p{$package} = 1;
893                }
894           }
895           $package_keys += $key_inc;
896      }
897      if (exists $param{maint}) {
898           my $key_inc = 0;
899           my %_temp_p = ();
900           for my $package (package_maintainer(maintainer=>$param{maint})) {
901                $packages{$package}++ unless exists $_temp_p{$package};
902                $_temp_p{$package} = 1;
903                $key_inc = 1;
904           }
905           $package_keys += $key_inc;
906      }
907      return grep {$packages{$_} >= $package_keys} keys %packages;
908 }
909
910 state $field_match = {
911     'subject' => \&__contains_field_match,
912     'tags' => sub {
913         my ($field, $values, $status) = @_; 
914         my %values = map {$_=>1} @$values;
915         foreach my $t (split /\s+/, $status->{$field}) {
916             return 1 if (defined $values{$t});
917         }
918         return 0;
919     },
920     'severity' => \&__exact_field_match,
921     'pending' => \&__exact_field_match,
922     'package' => \&__exact_field_match,
923     'originator' => \&__contains_field_match,
924     'forwarded' => \&__contains_field_match,
925     'owner' => \&__contains_field_match,
926 };
927
928 sub __bug_matches {
929     my ($hash, $status) = @_;
930     foreach my $key( keys( %$hash ) ) {
931         my $value = $hash->{$key};
932         next unless exists $field_match->{$key};
933         my $sub = $field_match->{$key};
934         if (not defined $sub) {
935             die "No defined subroutine for key: $key";
936         }
937         return 1 if ($sub->($key, $value, $status));
938     }
939     return 0;
940 }
941
942 sub __exact_field_match {
943     my ($field, $values, $status) = @_; 
944     my @values = @$values;
945     my @ret = grep {$_ eq $status->{$field} } @values;
946     $#ret != -1;
947 }
948
949 sub __contains_field_match {
950     my ($field, $values, $status) = @_; 
951     foreach my $data (@$values) {
952         return 1 if (index($status->{$field}, $data) > -1);
953     }
954     return 0;
955 }
956
957
958
959
960
961 1;
962
963 __END__