Debbugs/Bugs.pm

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