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
 308
 309 =cut
 310
 311 sub bug_filter {
 312      my %param = validate_with(params => \@_,
 313                                spec   => {bug    => {type => ARRAYREF|SCALAR,
 314                                                      optional => 1,
 315                                                     },
 316                                           status => {type => HASHREF|ARRAYREF,
 317                                                      optional => 1,
 318                                                     },
 319                                           seen_merged => {type => HASHREF,
 320                                                           optional => 1,
 321                                                          },
 322                                           repeat_merged => {type => BOOLEAN,
 323                                                             optional => 1,
 324                                                            },
 325                                           include => {type => HASHREF,
 326                                                       optional => 1,
 327                                                      },
 328                                           exclude => {type => HASHREF,
 329                                                       optional => 1,
 330                                                      },
 331                                           min_days => {type => SCALAR,
 332                                                        optional => 1,
 333                                                       },
 334                                           max_days => {type => SCALAR,
 335                                                        optional => 1,
 336                                                       },
 337                                          },
 338                               );
 339      if (exists $param{repeat_merged} and
 340          not $param{repeat_merged} and
 341          not defined $param{seen_merged}) {
 342           croak "repeat_merged false requires seen_merged to be passed";
 343      }
 344      if (not exists $param{bug} and not exists $param{status}) {
 345          croak "one of bug or status must be passed";
 346      }
 347
 348      if (not exists $param{status}) {
 349           my $location = getbuglocation($param{bug}, 'summary');
 350           return 0 if not defined $location or not length $location;
 351           $param{status} = readbug( $param{bug}, $location );
 352           return 0 if not defined $param{status};
 353      }
 354
 355      if (exists $param{include}) {
 356           return 1 if (!__bug_matches($param{include}, $param{status}));
 357      }
 358      if (exists $param{exclude}) {
 359           return 1 if (__bug_matches($param{exclude}, $param{status}));
 360      }
 361      if (exists $param{repeat_merged} and not $param{repeat_merged}) {
 362           my @merged = sort {$a<=>$b} $param{bug}, split(/ /, $param{status}{mergedwith});
 363           return 1 if first {defined $_} @{$param{seen_merged}}{@merged};
 364           @{$param{seen_merged}}{@merged} = (1) x @merged;
 365      }
 366      my $daysold = int((time - $param{status}{date}) / 86400);   # seconds to days
 367      if (exists $param{min_days}) {
 368           return 1 unless $param{min_days} <= $daysold;
 369      }
 370      if (exists $param{max_days}) {
 371           return 1 unless $param{max_days} == -1 or
 372                $param{max_days} >= $daysold;
 373      }
 374      return 0;
 375 }
 376
 377
 378 =head2 get_bugs_by_idx
 379
 380 This routine uses the by-$index.idx indicies to try to speed up
 381 searches.
 382
 383
 384 =cut
 385
 386 sub get_bugs_by_idx{
 387      my %param = validate_with(params => \@_,
 388                                spec   => {package   => {type => SCALAR|ARRAYREF,
 389                                                         optional => 1,
 390                                                        },
 391                                           submitter => {type => SCALAR|ARRAYREF,
 392                                                         optional => 1,
 393                                                        },
 394                                           severity  => {type => SCALAR|ARRAYREF,
 395                                                         optional => 1,
 396                                                        },
 397                                           tag       => {type => SCALAR|ARRAYREF,
 398                                                         optional => 1,
 399                                                        },
 400                                           archive   => {type => BOOLEAN,
 401                                                         default => 0,
 402                                                        },
 403                                           owner     => {type => SCALAR|ARRAYREF,
 404                                                         optional => 1,
 405                                                        },
 406                                           src       => {type => SCALAR|ARRAYREF,
 407                                                         optional => 1,
 408                                                        },
 409                                           maint     => {type => SCALAR|ARRAYREF,
 410                                                         optional => 1,
 411                                                        },
 412                                           bugs      => {type => SCALAR|ARRAYREF,
 413                                                         optional => 1,
 414                                                        },
 415                                           correspondent => {type => SCALAR|ARRAYREF,
 416                                                             optional => 1,
 417                                                            },
 418                                           usertags  => {type => HASHREF,
 419                                                         optional => 1,
 420                                                        },
 421                                          },
 422                               );
 423      my %bugs = ();
 424
 425      # We handle src packages, maint and maintenc by mapping to the
 426      # appropriate binary packages, then removing all packages which
 427      # don't match all queries
 428      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 429                                                qw(package src maint)
 430                                               );
 431      if (exists $param{package} or
 432          exists $param{src} or
 433          exists $param{maint}) {
 434           delete @param{qw(maint src)};
 435           $param{package} = [@packages];
 436      }
 437      my $keys = grep {$_ !~ /^(archive|usertags|bugs)$/} keys(%param);
 438      die "Need at least 1 key to search by" unless $keys;
 439      my $arc = $param{archive} ? '-arc':'';
 440      my %idx;
 441      for my $key (grep {$_ !~ /^(archive|usertags|bugs)$/} keys %param) {
 442           my $index = $key;
 443           $index = 'submitter-email' if $key eq 'submitter';
 444           $index = "$config{spool_dir}/by-${index}${arc}.idx";
 445           tie(%idx, MLDBM => $index, O_RDONLY)
 446                or die "Unable to open $index: $!";
 447           my %bug_matching = ();
 448           for my $search (make_list($param{$key})) {
 449                for my $bug (keys %{$idx{$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                if ($search ne lc($search)) {
 456                     for my $bug (keys %{$idx{lc($search)}||{}}) {
 457                          next if $bug_matching{$bug};
 458                          # increment the number of searches that this bug matched
 459                          $bugs{$bug}++;
 460                          $bug_matching{$bug}=1;
 461                     }
 462                }
 463           }
 464           if ($key eq 'tag' and exists $param{usertags}) {
 465                for my $bug (make_list(grep {defined $_ } @{$param{usertags}}{make_list($param{tag})})) {
 466                     next if $bug_matching{$bug};
 467                     $bugs{$bug}++;
 468                     $bug_matching{$bug}=1;
 469                }
 470           }
 471           untie %idx or die 'Unable to untie %idx';
 472      }
 473      if ($param{bugs}) {
 474           $keys++;
 475           for my $bug (make_list($param{bugs})) {
 476                $bugs{$bug}++;
 477           }
 478      }
 479      # Throw out results that do not match all of the search specifications
 480      return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
 481 }
 482
 483
 484 =head2 get_bugs_flatfile
 485
 486 This is the fallback search routine. It should be able to complete all
 487 searches. [Or at least, that's the idea.]
 488
 489 =cut
 490
 491 sub get_bugs_flatfile{
 492      my %param = validate_with(params => \@_,
 493                                spec   => {package   => {type => SCALAR|ARRAYREF,
 494                                                         optional => 1,
 495                                                        },
 496                                           src       => {type => SCALAR|ARRAYREF,
 497                                                         optional => 1,
 498                                                        },
 499                                           maint     => {type => SCALAR|ARRAYREF,
 500                                                         optional => 1,
 501                                                        },
 502                                           submitter => {type => SCALAR|ARRAYREF,
 503                                                         optional => 1,
 504                                                        },
 505                                           severity  => {type => SCALAR|ARRAYREF,
 506                                                         optional => 1,
 507                                                        },
 508                                           status    => {type => SCALAR|ARRAYREF,
 509                                                         optional => 1,
 510                                                        },
 511                                           tag       => {type => SCALAR|ARRAYREF,
 512                                                         optional => 1,
 513                                                        },
 514                                           owner     => {type => SCALAR|ARRAYREF,
 515                                                         optional => 1,
 516                                                        },
 517                                           correspondent => {type => SCALAR|ARRAYREF,
 518                                                             optional => 1,
 519                                                            },
 520 # not yet supported
 521 #                                         dist      => {type => SCALAR|ARRAYREF,
 522 #                                                       optional => 1,
 523 #                                                      },
 524                                           archive   => {type => BOOLEAN,
 525                                                         default => 1,
 526                                                        },
 527                                           usertags  => {type => HASHREF,
 528                                                         optional => 1,
 529                                                        },
 530                                           function  => {type => CODEREF,
 531                                                         optional => 1,
 532                                                        },
 533                                          },
 534                               );
 535      my $flatfile;
 536      if ($param{archive}) {
 537           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
 538                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
 539      }
 540      else {
 541           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
 542                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
 543      }
 544      my %usertag_bugs;
 545      if (exists $param{tag} and exists $param{usertags}) {
 546           # This complex slice makes a hash with the bugs which have the
 547           # usertags passed in $param{tag} set.
 548           @usertag_bugs{make_list(@{$param{usertags}}{make_list($param{tag})})
 549                         } = (1) x make_list(@{$param{usertags}}{make_list($param{tag})});
 550      }
 551      # We handle src packages, maint and maintenc by mapping to the
 552      # appropriate binary packages, then removing all packages which
 553      # don't match all queries
 554      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 555                                                qw(package src maint)
 556                                               );
 557      if (exists $param{package} or
 558          exists $param{src} or
 559          exists $param{maint}) {
 560           delete @param{qw(maint src)};
 561           $param{package} = [@packages];
 562      }
 563      my $grep_bugs = 0;
 564      my %bugs;
 565      if (exists $param{bugs}) {
 566           $bugs{$_} = 1 for make_list($param{bugs});
 567           $grep_bugs = 1;
 568      }
 569      if (exists $param{owner} or exists $param{correspondent}) {
 570           $bugs{$_} = 1 for get_bugs_by_idx(exists $param{correspondent}?(correspondent => $param{correspondent}):(),
 571                                             exists $param{owner}?(owner => $param{owner}):(),
 572                                            );
 573           $grep_bugs = 1;
 574      }
 575      my @bugs;
 576      while (<$flatfile>) {
 577           next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
 578           my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
 579           next if $grep_bugs and not exists $bugs{$bug};
 580           if (exists $param{package}) {
 581                my @packages = splitpackages($pkg);
 582                next unless grep { my $pkg_list = $_;
 583                                   grep {$pkg_list eq $_} make_list($param{package})
 584                              } @packages;
 585           }
 586           if (exists $param{src}) {
 587                my @src_packages = map { getsrcpkgs($_)} make_list($param{src});
 588                my @packages = splitpackages($pkg);
 589                next unless grep { my $pkg_list = $_;
 590                                   grep {$pkg_list eq $_} @packages
 591                              } @src_packages;
 592           }
 593           if (exists $param{submitter}) {
 594                my @p_addrs = map {lc($_->address)}
 595                     map {getparsedaddrs($_)}
 596                          make_list($param{submitter});
 597                my @f_addrs = map {$_->address}
 598                     getparsedaddrs($submitter||'');
 599                next unless grep { my $f_addr = $_;
 600                                   grep {$f_addr eq $_} @p_addrs
 601                              } @f_addrs;
 602           }
 603           next if exists $param{severity} and not grep {$severity eq $_} make_list($param{severity});
 604           next if exists $param{status} and not grep {$status eq $_} make_list($param{status});
 605           if (exists $param{tag}) {
 606                my $bug_ok = 0;
 607                # either a normal tag, or a usertag must be set
 608                $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
 609                my @bug_tags = split ' ', $tags;
 610                $bug_ok = 1 if grep {my $bug_tag = $_;
 611                                     grep {$bug_tag eq $_} make_list($param{tag});
 612                                } @bug_tags;
 613                next unless $bug_ok;
 614           }
 615           # We do this last, because a function may be slow...
 616           if (exists $param{function}) {
 617                my @bug_tags = split ' ', $tags;
 618                my @packages = splitpackages($pkg);
 619                my $package = (@packages > 1)?\@packages:$packages[0];
 620                next unless
 621                     $param{function}->(pkg       => $package,
 622                                        bug       => $bug,
 623                                        status    => $status,
 624                                        submitter => $submitter,
 625                                        severity  => $severity,
 626                                        tags      => \@bug_tags,
 627                                       );
 628           }
 629           push @bugs, $bug;
 630      }
 631      return @bugs;
 632 }
 633
 634 =head1 PRIVATE FUNCTIONS
 635
 636 =head2 __handle_pkg_src_and_maint
 637
 638      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 639                                                qw(package src maint)
 640                                               );
 641
 642 Turn package/src/maint into a list of packages
 643
 644 =cut
 645
 646 sub __handle_pkg_src_and_maint{
 647      my %param = validate_with(params => \@_,
 648                                spec   => {package   => {type => SCALAR|ARRAYREF,
 649                                                         optional => 1,
 650                                                        },
 651                                           src       => {type => SCALAR|ARRAYREF,
 652                                                         optional => 1,
 653                                                        },
 654                                           maint     => {type => SCALAR|ARRAYREF,
 655                                                         optional => 1,
 656                                                        },
 657                                          },
 658                                allow_extra => 1,
 659                               );
 660
 661      my @packages;
 662      @packages = make_list($param{package}) if exists $param{package};
 663      my $package_keys = @packages?1:0;
 664      my %packages;
 665      @packages{@packages} = (1) x @packages;
 666      if (exists $param{src}) {
 667           # We only want to increment the number of keys if there is
 668           # something to match
 669           my $key_inc = 0;
 670           for my $package ((map { getsrcpkgs($_)} make_list($param{src})),make_list($param{src})) {
 671                $packages{$package}++;
 672                $key_inc=1;
 673           }
 674           $package_keys += $key_inc;
 675      }
 676      if (exists $param{maint}) {
 677           my $key_inc = 0;
 678           my $maint_rev = getmaintainers_reverse();
 679           for my $package (map { exists $maint_rev->{$_}?@{$maint_rev->{$_}}:()}
 680                            make_list($param{maint})) {
 681                $packages{$package}++;
 682                $key_inc = 1;
 683           }
 684           $package_keys += $key_inc;
 685      }
 686      return grep {$packages{$_} >= $package_keys} keys %packages;
 687 }
 688
 689 my %field_match = (
 690     'subject' => \&__contains_field_match,
 691     'tags' => sub {
 692         my ($field, $values, $status) = @_;
 693         my %values = map {$_=>1} @$values;
 694         foreach my $t (split /\s+/, $status->{$field}) {
 695             return 1 if (defined $values{$t});
 696         }
 697         return 0;
 698     },
 699     'severity' => \&__exact_field_match,
 700     'pending' => \&__exact_field_match,
 701     'originator' => \&__contains_field_match,
 702     'forwarded' => \&__contains_field_match,
 703     'owner' => \&__contains_field_match,
 704 );
 705
 706 sub __bug_matches {
 707     my ($hash, $status) = @_;
 708     foreach my $key( keys( %$hash ) ) {
 709         my $value = $hash->{$key};
 710         my $sub = $field_match{$key};
 711         return 1 if ($sub->($key, $value, $status));
 712     }
 713     return 0;
 714 }
 715
 716 sub __exact_field_match {
 717     my ($field, $values, $status) = @_;
 718     my @values = @$values;
 719     my @ret = grep {$_ eq $status->{$field} } @values;
 720     $#ret != -1;
 721 }
 722
 723 sub __contains_field_match {
 724     my ($field, $values, $status) = @_;
 725     foreach my $data (@$values) {
 726         return 1 if (index($status->{$field}, $data) > -1);
 727     }
 728     return 0;
 729 }
 730
 731
 732
 733
 734
 735 1;
 736
 737 __END__