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