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::Util 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 %_get_bugs_common_options =
 156     (package   => {type => SCALAR|ARRAYREF,
 157                    optional => 1,
 158                   },
 159      src       => {type => SCALAR|ARRAYREF,
 160                    optional => 1,
 161                   },
 162      maint     => {type => SCALAR|ARRAYREF,
 163                    optional => 1,
 164                   },
 165      submitter => {type => SCALAR|ARRAYREF,
 166                    optional => 1,
 167                   },
 168      severity  => {type => SCALAR|ARRAYREF,
 169                    optional => 1,
 170                   },
 171      status    => {type => SCALAR|ARRAYREF,
 172                    optional => 1,
 173                   },
 174      tag       => {type => SCALAR|ARRAYREF,
 175                    optional => 1,
 176                   },
 177      owner     => {type => SCALAR|ARRAYREF,
 178                    optional => 1,
 179                   },
 180      dist      => {type => SCALAR|ARRAYREF,
 181                    optional => 1,
 182                   },
 183      correspondent => {type => SCALAR|ARRAYREF,
 184                        optional => 1,
 185                       },
 186      affects   => {type => SCALAR|ARRAYREF,
 187                    optional => 1,
 188                   },
 189      function  => {type => CODEREF,
 190                    optional => 1,
 191                   },
 192      bugs      => {type => SCALAR|ARRAYREF,
 193                    optional => 1,
 194                   },
 195      archive   => {type => BOOLEAN|SCALAR,
 196                    default => 0,
 197                   },
 198      usertags  => {type => HASHREF,
 199                    optional => 1,
 200                   },
 201     );
 202
 203
 204 my $_get_bugs_options = {%_get_bugs_common_options};
 205 sub get_bugs{
 206      my %param = validate_with(params => \@_,
 207                                spec   => $_get_bugs_options,
 208                               );
 209
 210      # Normalize options
 211      my %options = %param;
 212      my @bugs;
 213      if ($options{archive} eq 'both') {
 214           push @bugs, get_bugs(%options,archive=>0);
 215           push @bugs, get_bugs(%options,archive=>1);
 216           my %bugs;
 217           @bugs{@bugs} = @bugs;
 218           return keys %bugs;
 219      }
 220      # A configuration option will set an array that we'll use here instead.
 221      for my $routine (qw(Debbugs::Bugs::get_bugs_by_idx Debbugs::Bugs::get_bugs_flatfile)) {
 222           my ($package) = $routine =~ m/^(.+)\:\:/;
 223           eval "use $package;";
 224           if ($@) {
 225                # We output errors here because using an invalid function
 226                # in the configuration file isn't something that should
 227                # be done.
 228                warn "use $package failed with $@";
 229                next;
 230           }
 231           @bugs = eval "${routine}(\%options)";
 232           if ($@) {
 233
 234                # We don't output errors here, because failure here
 235                # via die may be a perfectly normal thing.
 236                print STDERR "$@" if $DEBUG;
 237                next;
 238           }
 239           last;
 240      }
 241      # If no one succeeded, die
 242      if ($@) {
 243           die "$@";
 244      }
 245      return @bugs;
 246 }
 247
 248 =head2 count_bugs
 249
 250      count_bugs(function => sub {...})
 251
 252 Uses a subroutine to classify bugs into categories and return the
 253 number of bugs which fall into those categories
 254
 255 =cut
 256
 257 sub count_bugs {
 258      my %param = validate_with(params => \@_,
 259                                spec   => {function => {type => CODEREF,
 260                                                       },
 261                                           archive  => {type => BOOLEAN,
 262                                                        default => 0,
 263                                                       },
 264                                          },
 265                               );
 266      my $flatfile;
 267      if ($param{archive}) {
 268           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
 269                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
 270      }
 271      else {
 272           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
 273                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
 274      }
 275      my %count = ();
 276      while(<$flatfile>) {
 277           if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) {
 278                my @x = $param{function}->(pkg       => $1,
 279                                           bug       => $2,
 280                                           status    => $4,
 281                                           submitter => $5,
 282                                           severity  => $6,
 283                                           tags      => $7,
 284                                          );
 285                local $_;
 286                $count{$_}++ foreach @x;
 287           }
 288      }
 289      close $flatfile;
 290      return %count;
 291 }
 292
 293 =head2 newest_bug
 294
 295      my $bug = newest_bug();
 296
 297 Returns the bug number of the newest bug, which is nextnumber-1.
 298
 299 =cut
 300
 301 sub newest_bug {
 302      my $nn_fh = IO::File->new("$config{spool_dir}/nextnumber",'r')
 303           or die "Unable to open $config{spool_dir}nextnumber for reading: $!";
 304      local $/;
 305      my $next_number = <$nn_fh>;
 306      close $nn_fh;
 307      chomp $next_number;
 308      return $next_number-1;
 309 }
 310
 311 =head2 bug_filter
 312
 313      bug_filter
 314
 315 Allows filtering bugs on commonly used criteria
 316
 317
 318
 319 =cut
 320
 321 sub bug_filter {
 322      my %param = validate_with(params => \@_,
 323                                spec   => {bug    => {type => ARRAYREF|SCALAR,
 324                                                      optional => 1,
 325                                                     },
 326                                           status => {type => HASHREF|ARRAYREF,
 327                                                      optional => 1,
 328                                                     },
 329                                           seen_merged => {type => HASHREF,
 330                                                           optional => 1,
 331                                                          },
 332                                           repeat_merged => {type => BOOLEAN,
 333                                                             default => 1,
 334                                                            },
 335                                           include => {type => HASHREF,
 336                                                       optional => 1,
 337                                                      },
 338                                           exclude => {type => HASHREF,
 339                                                       optional => 1,
 340                                                      },
 341                                           min_days => {type => SCALAR,
 342                                                        optional => 1,
 343                                                       },
 344                                           max_days => {type => SCALAR,
 345                                                        optional => 1,
 346                                                       },
 347                                          },
 348                               );
 349      if (exists $param{repeat_merged} and
 350          not $param{repeat_merged} and
 351          not defined $param{seen_merged}) {
 352           croak "repeat_merged false requires seen_merged to be passed";
 353      }
 354      if (not exists $param{bug} and not exists $param{status}) {
 355          croak "one of bug or status must be passed";
 356      }
 357
 358      if (not exists $param{status}) {
 359           my $location = getbuglocation($param{bug}, 'summary');
 360           return 0 if not defined $location or not length $location;
 361           $param{status} = readbug( $param{bug}, $location );
 362           return 0 if not defined $param{status};
 363      }
 364
 365      if (exists $param{include}) {
 366           return 1 if (!__bug_matches($param{include}, $param{status}));
 367      }
 368      if (exists $param{exclude}) {
 369           return 1 if (__bug_matches($param{exclude}, $param{status}));
 370      }
 371      if (exists $param{repeat_merged} and not $param{repeat_merged}) {
 372           my @merged = sort {$a<=>$b} $param{bug}, split(/ /, $param{status}{mergedwith});
 373           return 1 if first {defined $_} @{$param{seen_merged}}{@merged};
 374           @{$param{seen_merged}}{@merged} = (1) x @merged;
 375      }
 376      my $daysold = int((time - $param{status}{date}) / 86400);   # seconds to days
 377      if (exists $param{min_days}) {
 378           return 1 unless $param{min_days} <= $daysold;
 379      }
 380      if (exists $param{max_days}) {
 381           return 1 unless $param{max_days} == -1 or
 382                $param{max_days} >= $daysold;
 383      }
 384      return 0;
 385 }
 386
 387
 388 =head2 get_bugs_by_idx
 389
 390 This routine uses the by-$index.idx indicies to try to speed up
 391 searches.
 392
 393
 394 =cut
 395
 396
 397 my $_get_bugs_by_idx_options =
 398    {hash_slice(%_get_bugs_common_options,
 399                (qw(package submitter severity tag archive),
 400                 qw(owner src maint bugs correspondent),
 401                 qw(affects usertags))
 402               )
 403    };
 404 sub get_bugs_by_idx{
 405      my %param = validate_with(params => \@_,
 406                                spec   => $_get_bugs_by_idx_options
 407                               );
 408      my %bugs = ();
 409
 410      # If we're given an empty maint (unmaintained packages), we can't
 411      # handle it, so bail out here
 412      for my $maint (make_list(exists $param{maint}?$param{maint}:[])) {
 413           if (defined $maint and $maint eq '') {
 414                die "Can't handle empty maint (unmaintained packages) in get_bugs_by_idx";
 415           }
 416      }
 417
 418      # We handle src packages, maint and maintenc by mapping to the
 419      # appropriate binary packages, then removing all packages which
 420      # don't match all queries
 421      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 422                                                qw(package src maint)
 423                                               );
 424      if (exists $param{package} or
 425          exists $param{src} or
 426          exists $param{maint}) {
 427           delete @param{qw(maint src)};
 428           $param{package} = [@packages];
 429      }
 430      my $keys = grep {$_ !~ /^(archive|usertags|bugs)$/} keys(%param);
 431      die "Need at least 1 key to search by" unless $keys;
 432      my $arc = $param{archive} ? '-arc':'';
 433      my %idx;
 434      for my $key (grep {$_ !~ /^(archive|usertags|bugs)$/} keys %param) {
 435           my $index = $key;
 436           $index = 'submitter-email' if $key eq 'submitter';
 437           $index = "$config{spool_dir}/by-${index}${arc}.idx";
 438           tie(%idx, MLDBM => $index, O_RDONLY)
 439                or die "Unable to open $index: $!";
 440           my %bug_matching = ();
 441           for my $search (make_list($param{$key})) {
 442                for my $bug (keys %{$idx{$search}||{}}) {
 443                     next if $bug_matching{$bug};
 444                     # increment the number of searches that this bug matched
 445                     $bugs{$bug}++;
 446                     $bug_matching{$bug}=1;
 447                }
 448                if ($search ne lc($search)) {
 449                     for my $bug (keys %{$idx{lc($search)}||{}}) {
 450                          next if $bug_matching{$bug};
 451                          # increment the number of searches that this bug matched
 452                          $bugs{$bug}++;
 453                          $bug_matching{$bug}=1;
 454                     }
 455                }
 456           }
 457           if ($key eq 'tag' and exists $param{usertags}) {
 458                for my $bug (make_list(grep {defined $_ } @{$param{usertags}}{make_list($param{tag})})) {
 459                     next if $bug_matching{$bug};
 460                     $bugs{$bug}++;
 461                     $bug_matching{$bug}=1;
 462                }
 463           }
 464           untie %idx or die 'Unable to untie %idx';
 465      }
 466      if ($param{bugs}) {
 467           $keys++;
 468           for my $bug (make_list($param{bugs})) {
 469                $bugs{$bug}++;
 470           }
 471      }
 472      # Throw out results that do not match all of the search specifications
 473      return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
 474 }
 475
 476
 477 =head2 get_bugs_flatfile
 478
 479 This is the fallback search routine. It should be able to complete all
 480 searches. [Or at least, that's the idea.]
 481
 482 =cut
 483
 484 my $_get_bugs_flatfile_options =
 485    {hash_slice(%_get_bugs_common_options,
 486                map {$_ eq 'dist'?():($_)} keys %_get_bugs_common_options
 487               )
 488    };
 489
 490 sub get_bugs_flatfile{
 491      my %param = validate_with(params => \@_,
 492                                spec   => $_get_bugs_flatfile_options
 493                               );
 494      my $flatfile;
 495      if ($param{archive}) {
 496           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
 497                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
 498      }
 499      else {
 500           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
 501                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
 502      }
 503      my %usertag_bugs;
 504      if (exists $param{tag} and exists $param{usertags}) {
 505           # This complex slice makes a hash with the bugs which have the
 506           # usertags passed in $param{tag} set.
 507           @usertag_bugs{make_list(@{$param{usertags}}{make_list($param{tag})})
 508                         } = (1) x make_list(@{$param{usertags}}{make_list($param{tag})});
 509      }
 510      my $unmaintained_packages = 0;
 511      # unmaintained packages is a special case
 512      my @maints = make_list(exists $param{maint}?$param{maint}:[]);
 513      $param{maint} = [];
 514      for my $maint (@maints) {
 515           if (defined $maint and $maint eq '' and not $unmaintained_packages) {
 516                $unmaintained_packages = 1;
 517                our %maintainers = %{getmaintainers()};
 518                $param{function} = [(exists $param{function}?
 519                                     (ref $param{function}?@{$param{function}}:$param{function}):()),
 520                                    sub {my %d=@_;
 521                                         foreach my $try (make_list($d{"pkg"})) {
 522                                              next unless length $try;
 523                                              ($try) = $try =~ m/^(?:src:)?(.+)/;
 524                                              return 1 if not exists $maintainers{$try};
 525                                         }
 526                                         return 0;
 527                                    }
 528                                   ];
 529           }
 530           elsif (defined $maint and $maint ne '') {
 531                push @{$param{maint}},$maint;
 532           }
 533      }
 534      # We handle src packages, maint and maintenc by mapping to the
 535      # appropriate binary packages, then removing all packages which
 536      # don't match all queries
 537      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 538                                                qw(package src maint)
 539                                               );
 540      if (exists $param{package} or
 541          exists $param{src} or
 542          exists $param{maint}) {
 543           delete @param{qw(maint src)};
 544           $param{package} = [@packages] if @packages;
 545      }
 546      my $grep_bugs = 0;
 547      my %bugs;
 548      if (exists $param{bugs}) {
 549           $bugs{$_} = 1 for make_list($param{bugs});
 550           $grep_bugs = 1;
 551      }
 552      # These queries have to be handled by get_bugs_by_idx
 553      if (exists $param{owner}
 554          or exists $param{correspondent}
 555          or exists $param{affects}) {
 556           $bugs{$_} = 1 for get_bugs_by_idx(map {exists $param{$_}?($_,$param{$_}):()}
 557                                             qw(owner correspondent affects),
 558                                            );
 559           $grep_bugs = 1;
 560      }
 561      my @bugs;
 562      BUG: while (<$flatfile>) {
 563           next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*(.*)\s*\]\s+(\w+)\s+(.*)$/;
 564           my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
 565           next if $grep_bugs and not exists $bugs{$bug};
 566           if (exists $param{package}) {
 567                my @packages = splitpackages($pkg);
 568                next unless grep { my $pkg_list = $_;
 569                                   grep {$pkg_list eq $_} make_list($param{package})
 570                              } @packages;
 571           }
 572           if (exists $param{src}) {
 573                my @src_packages = map { getsrcpkgs($_)} make_list($param{src});
 574                my @packages = splitpackages($pkg);
 575                next unless grep { my $pkg_list = $_;
 576                                   grep {$pkg_list eq $_} @packages
 577                              } @src_packages;
 578           }
 579           if (exists $param{submitter}) {
 580                my @p_addrs = map {lc($_->address)}
 581                     map {getparsedaddrs($_)}
 582                          make_list($param{submitter});
 583                my @f_addrs = map {$_->address}
 584                     getparsedaddrs($submitter||'');
 585                next unless grep { my $f_addr = $_;
 586                                   grep {$f_addr eq $_} @p_addrs
 587                              } @f_addrs;
 588           }
 589           next if exists $param{severity} and not grep {$severity eq $_} make_list($param{severity});
 590           next if exists $param{status} and not grep {$status eq $_} make_list($param{status});
 591           if (exists $param{tag}) {
 592                my $bug_ok = 0;
 593                # either a normal tag, or a usertag must be set
 594                $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
 595                my @bug_tags = split ' ', $tags;
 596                $bug_ok = 1 if grep {my $bug_tag = $_;
 597                                     grep {$bug_tag eq $_} make_list($param{tag});
 598                                } @bug_tags;
 599                next unless $bug_ok;
 600           }
 601           # We do this last, because a function may be slow...
 602           if (exists $param{function}) {
 603                my @bug_tags = split ' ', $tags;
 604                my @packages = splitpackages($pkg);
 605                my $package = (@packages > 1)?\@packages:$packages[0];
 606                for my $function (make_list($param{function})) {
 607                     next BUG unless
 608                          $function->(pkg       => $package,
 609                                      bug       => $bug,
 610                                      status    => $status,
 611                                      submitter => $submitter,
 612                                      severity  => $severity,
 613                                      tags      => \@bug_tags,
 614                                     );
 615                }
 616           }
 617           push @bugs, $bug;
 618      }
 619      return @bugs;
 620 }
 621
 622 =head1 PRIVATE FUNCTIONS
 623
 624 =head2 __handle_pkg_src_and_maint
 625
 626      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 627                                                qw(package src maint)
 628                                               );
 629
 630 Turn package/src/maint into a list of packages
 631
 632 =cut
 633
 634 sub __handle_pkg_src_and_maint{
 635      my %param = validate_with(params => \@_,
 636                                spec   => {package   => {type => SCALAR|ARRAYREF,
 637                                                         optional => 1,
 638                                                        },
 639                                           src       => {type => SCALAR|ARRAYREF,
 640                                                         optional => 1,
 641                                                        },
 642                                           maint     => {type => SCALAR|ARRAYREF,
 643                                                         optional => 1,
 644                                                        },
 645                                          },
 646                                allow_extra => 1,
 647                               );
 648
 649      my @packages;
 650      @packages = make_list($param{package}) if exists $param{package};
 651      my $package_keys = @packages?1:0;
 652      my %packages;
 653      @packages{@packages} = (1) x @packages;
 654      if (exists $param{src}) {
 655           # We only want to increment the number of keys if there is
 656           # something to match
 657           my $key_inc = 0;
 658           # in case there are binaries with the same name as the
 659           # source
 660           my %_temp_p = ();
 661           for my $package ((map {getsrcpkgs($_)} make_list($param{src}))) {
 662                $packages{$package}++ unless exists $_temp_p{$package};
 663                $_temp_p{$package} = 1;
 664                $key_inc=1;
 665           }
 666           for my $package (make_list($param{src})) {
 667                $packages{"src:$package"}++ unless exists $_temp_p{"src:$package"};
 668                $_temp_p{"src:$package"} = 1;
 669                $key_inc=1;
 670                # As a temporary hack, we will also include $param{src}
 671                # in this list for packages passed which do not have a
 672                # corresponding binary package
 673                if (not exists getpkgsrc()->{$package}) {
 674                    $packages{$package}++ unless exists $_temp_p{$package};
 675                    $_temp_p{$package} = 1;
 676                }
 677           }
 678           $package_keys += $key_inc;
 679      }
 680      if (exists $param{maint}) {
 681           my $key_inc = 0;
 682           my %_temp_p = ();
 683           for my $package (package_maintainer(maintainer=>$param{maint})) {
 684                $packages{$package}++ unless exists $_temp_p{$package};
 685                $_temp_p{$package} = 1;
 686                $key_inc = 1;
 687           }
 688           $package_keys += $key_inc;
 689      }
 690      return grep {$packages{$_} >= $package_keys} keys %packages;
 691 }
 692
 693 my %field_match = (
 694     'subject' => \&__contains_field_match,
 695     'tags' => sub {
 696         my ($field, $values, $status) = @_;
 697         my %values = map {$_=>1} @$values;
 698         foreach my $t (split /\s+/, $status->{$field}) {
 699             return 1 if (defined $values{$t});
 700         }
 701         return 0;
 702     },
 703     'severity' => \&__exact_field_match,
 704     'pending' => \&__exact_field_match,
 705     'package' => \&__exact_field_match,
 706     'originator' => \&__contains_field_match,
 707     'forwarded' => \&__contains_field_match,
 708     'owner' => \&__contains_field_match,
 709 );
 710
 711 sub __bug_matches {
 712     my ($hash, $status) = @_;
 713     foreach my $key( keys( %$hash ) ) {
 714         my $value = $hash->{$key};
 715         next unless exists $field_match{$key};
 716         my $sub = $field_match{$key};
 717         if (not defined $sub) {
 718             die "No defined subroutine for key: $key";
 719         }
 720         return 1 if ($sub->($key, $value, $status));
 721     }
 722     return 0;
 723 }
 724
 725 sub __exact_field_match {
 726     my ($field, $values, $status) = @_;
 727     my @values = @$values;
 728     my @ret = grep {$_ eq $status->{$field} } @values;
 729     $#ret != -1;
 730 }
 731
 732 sub __contains_field_match {
 733     my ($field, $values, $status) = @_;
 734     foreach my $data (@$values) {
 735         return 1 if (index($status->{$field}, $data) > -1);
 736     }
 737     return 0;
 738 }
 739
 740
 741
 742
 743
 744 1;
 745
 746 __END__