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