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