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));
  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);
  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
  62 =head2 get_bugs
  63
  64      get_bugs()
  65
  66 =head3 Parameters
  67
  68 The following parameters can either be a single scalar or a reference
  69 to an array. The parameters are ANDed together, and the elements of
  70 arrayrefs are a parameter are ORed. Future versions of this may allow
  71 for limited regular expressions, and/or more complex expressions.
  72
  73 =over
  74
  75 =item package -- name of the binary package
  76
  77 =item src -- name of the source package
  78
  79 =item maint -- address of the maintainer
  80
  81 =item submitter -- address of the submitter
  82
  83 =item severity -- severity of the bug
  84
  85 =item status -- status of the bug
  86
  87 =item tag -- bug tags
  88
  89 =item owner -- owner of the bug
  90
  91 =item dist -- distribution (I don't know about this one yet)
  92
  93 =item bugs -- list of bugs to search within
  94
  95 =item function -- see description below
  96
  97 =back
  98
  99 =head3 Special options
 100
 101 The following options are special options used to modulate how the
 102 searches are performed.
 103
 104 =over
 105
 106 =item archive -- whether to search archived bugs or normal bugs;
 107 defaults to false. As a special case, if archive is 'both', but
 108 archived and unarchived bugs are returned.
 109
 110 =item usertags -- set of usertags and the bugs they are applied to
 111
 112 =back
 113
 114
 115 =head3 Subsidiary routines
 116
 117 All subsidiary routines get passed exactly the same set of options as
 118 get_bugs. If for some reason they are unable to handle the options
 119 passed (for example, they don't have the right type of index for the
 120 type of selection) they should die as early as possible. [Using
 121 Params::Validate and/or die when files don't exist makes this fairly
 122 trivial.]
 123
 124 This function will then immediately move on to the next subroutine,
 125 giving it the same arguments.
 126
 127 =head3 function
 128
 129 This option allows you to provide an arbitrary function which will be
 130 given the information in the index.db file. This will be super, super
 131 slow, so only do this if there's no other way to write the search.
 132
 133 You'll be given a list (which you can turn into a hash) like the
 134 following:
 135
 136  (pkg => ['a','b'], # may be a scalar (most common)
 137   bug => 1234,
 138   status => 'pending',
 139   submitter => 'boo@baz.com',
 140   severity => 'serious',
 141   tags => ['a','b','c'], # may be an empty arrayref
 142  )
 143
 144 The function should return 1 if the bug should be included; 0 if the
 145 bug should not.
 146
 147 =cut
 148
 149 sub get_bugs{
 150      my %param = validate_with(params => \@_,
 151                                spec   => {package   => {type => SCALAR|ARRAYREF,
 152                                                         optional => 1,
 153                                                        },
 154                                           src       => {type => SCALAR|ARRAYREF,
 155                                                         optional => 1,
 156                                                        },
 157                                           maint     => {type => SCALAR|ARRAYREF,
 158                                                         optional => 1,
 159                                                        },
 160                                           submitter => {type => SCALAR|ARRAYREF,
 161                                                         optional => 1,
 162                                                        },
 163                                           severity  => {type => SCALAR|ARRAYREF,
 164                                                         optional => 1,
 165                                                        },
 166                                           status    => {type => SCALAR|ARRAYREF,
 167                                                         optional => 1,
 168                                                        },
 169                                           tag       => {type => SCALAR|ARRAYREF,
 170                                                         optional => 1,
 171                                                        },
 172                                           owner     => {type => SCALAR|ARRAYREF,
 173                                                         optional => 1,
 174                                                        },
 175                                           dist      => {type => SCALAR|ARRAYREF,
 176                                                         optional => 1,
 177                                                        },
 178                                           function  => {type => CODEREF,
 179                                                         optional => 1,
 180                                                        },
 181                                           bugs      => {type => SCALAR|ARRAYREF,
 182                                                         optional => 1,
 183                                                        },
 184                                           archive   => {type => BOOLEAN|SCALAR,
 185                                                         default => 0,
 186                                                        },
 187                                           usertags  => {type => HASHREF,
 188                                                         optional => 1,
 189                                                        },
 190                                          },
 191                               );
 192
 193      # Normalize options
 194      my %options = %param;
 195      my @bugs;
 196      if ($options{archive} eq 'both') {
 197           push @bugs, get_bugs(%options,archive=>0);
 198           push @bugs, get_bugs(%options,archive=>1);
 199           my %bugs;
 200           @bugs{@bugs} = @bugs;
 201           return keys %bugs;
 202      }
 203      # A configuration option will set an array that we'll use here instead.
 204      for my $routine (qw(Debbugs::Bugs::get_bugs_by_idx Debbugs::Bugs::get_bugs_flatfile)) {
 205           my ($package) = $routine =~ m/^(.+)\:\:/;
 206           eval "use $package;";
 207           if ($@) {
 208                # We output errors here because using an invalid function
 209                # in the configuration file isn't something that should
 210                # be done.
 211                warn "use $package failed with $@";
 212                next;
 213           }
 214           @bugs = eval "${routine}(\%options)";
 215           if ($@) {
 216
 217                # We don't output errors here, because failure here
 218                # via die may be a perfectly normal thing.
 219                print STDERR "$@" if $DEBUG;
 220                next;
 221           }
 222           last;
 223      }
 224      # If no one succeeded, die
 225      if ($@) {
 226           die "$@";
 227      }
 228      return @bugs;
 229 }
 230
 231 =head2 count_bugs
 232
 233      count_bugs(function => sub {...})
 234
 235 Uses a subroutine to classify bugs into categories and return the
 236 number of bugs which fall into those categories
 237
 238 =cut
 239
 240 sub count_bugs {
 241      my %param = validate_with(params => \@_,
 242                                spec   => {function => {type => CODEREF,
 243                                                       },
 244                                           archive  => {type => BOOLEAN,
 245                                                        default => 0,
 246                                                       },
 247                                          },
 248                               );
 249      my $flatfile;
 250      if ($param{archive}) {
 251           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
 252                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
 253      }
 254      else {
 255           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
 256                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
 257      }
 258      my %count = ();
 259      while(<$flatfile>) {
 260           if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) {
 261                my @x = $param{function}->(pkg       => $1,
 262                                           bug       => $2,
 263                                           status    => $4,
 264                                           submitter => $5,
 265                                           severity  => $6,
 266                                           tags      => $7,
 267                                          );
 268                local $_;
 269                $count{$_}++ foreach @x;
 270           }
 271      }
 272      close $flatfile;
 273      return %count;
 274 }
 275
 276 =head2 newest_bug
 277
 278      my $bug = newest_bug();
 279
 280 Returns the bug number of the newest bug, which is nextnumber-1.
 281
 282 =cut
 283
 284 sub newest_bug {
 285      my $nn_fh = IO::File->new("$config{spool_dir}/nextnumber",'r')
 286           or die "Unable to open $config{spool_dir}nextnumber for reading: $!";
 287      local $/;
 288      my $next_number = <$nn_fh>;
 289      close $nn_fh;
 290      chomp $next_number;
 291      return $next_number+0;
 292 }
 293
 294
 295 =head2 get_bugs_by_idx
 296
 297 This routine uses the by-$index.idx indicies to try to speed up
 298 searches.
 299
 300
 301 =cut
 302
 303 sub get_bugs_by_idx{
 304      my %param = validate_with(params => \@_,
 305                                spec   => {package   => {type => SCALAR|ARRAYREF,
 306                                                         optional => 1,
 307                                                        },
 308                                           submitter => {type => SCALAR|ARRAYREF,
 309                                                         optional => 1,
 310                                                        },
 311                                           severity  => {type => SCALAR|ARRAYREF,
 312                                                         optional => 1,
 313                                                        },
 314                                           tag       => {type => SCALAR|ARRAYREF,
 315                                                         optional => 1,
 316                                                        },
 317                                           archive   => {type => BOOLEAN,
 318                                                         default => 0,
 319                                                        },
 320                                           owner     => {type => SCALAR|ARRAYREF,
 321                                                         optional => 1,
 322                                                        },
 323                                           src       => {type => SCALAR|ARRAYREF,
 324                                                         optional => 1,
 325                                                        },
 326                                           maint     => {type => SCALAR|ARRAYREF,
 327                                                         optional => 1,
 328                                                        },
 329                                           bugs      => {type => SCALAR|ARRAYREF,
 330                                                         optional => 1,
 331                                                        },
 332                                           usertags  => {type => HASHREF,
 333                                                         optional => 1,
 334                                                        },
 335                                          },
 336                               );
 337      my %bugs = ();
 338
 339      # We handle src packages, maint and maintenc by mapping to the
 340      # appropriate binary packages, then removing all packages which
 341      # don't match all queries
 342      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 343                                                qw(package src maint)
 344                                               );
 345      my %usertag_bugs;
 346      if (exists $param{tag} and exists $param{usertags}) {
 347           # This complex slice makes a hash with the bugs which have the
 348           # usertags passed in $param{tag} set.
 349           @usertag_bugs{make_list(@{$param{usertags}}{make_list($param{tag})})
 350                         } = (1) x make_list(@{$param{usertags}}{make_list($param{tag})});
 351      }
 352      if (exists $param{package} or
 353          exists $param{src} or
 354          exists $param{maint}) {
 355           delete @param{qw(maint src)};
 356           $param{package} = [@packages];
 357      }
 358      my $keys = keys(%param) - 1;
 359      die "Need at least 1 key to search by" unless $keys;
 360      my $arc = $param{archive} ? '-arc':'';
 361      my %idx;
 362      for my $key (grep {$_ !~ /^(archive|usertags|bugs)$/} keys %param) {
 363           my $index = $key;
 364           $index = 'submitter-email' if $key eq 'submitter';
 365           $index = "$config{spool_dir}/by-${index}${arc}.idx";
 366           tie(%idx, MLDBM => $index, O_RDONLY)
 367                or die "Unable to open $index: $!";
 368           my %bug_matching = ();
 369           for my $search (make_list($param{$key})) {
 370                next unless defined $idx{$search};
 371                for my $bug (keys %{$idx{$search}}) {
 372                     next if $bug_matching{$bug};
 373                     # increment the number of searches that this bug matched
 374                     $bugs{$bug}++;
 375                     $bug_matching{$bug}=1;
 376                }
 377           }
 378           if ($key eq 'tag' and exists $param{usertags}) {
 379                for my $bug (make_list(grep {defined $_ } @{$param{usertags}}{make_list($param{tag})})) {
 380                     next if $bug_matching{$bug};
 381                     $bugs{$bug}++;
 382                     $bug_matching{$bug}=1;
 383                }
 384           }
 385           untie %idx or die 'Unable to untie %idx';
 386      }
 387      if ($param{bugs}) {
 388           $keys++;
 389           for my $bug (make_list($param{bugs})) {
 390                $bugs{$bug}++;
 391           }
 392      }
 393      # Throw out results that do not match all of the search specifications
 394      return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
 395 }
 396
 397
 398 =head2 get_bugs_flatfile
 399
 400 This is the fallback search routine. It should be able to complete all
 401 searches. [Or at least, that's the idea.]
 402
 403 =cut
 404
 405 sub get_bugs_flatfile{
 406      my %param = validate_with(params => \@_,
 407                                spec   => {package   => {type => SCALAR|ARRAYREF,
 408                                                         optional => 1,
 409                                                        },
 410                                           src       => {type => SCALAR|ARRAYREF,
 411                                                         optional => 1,
 412                                                        },
 413                                           maint     => {type => SCALAR|ARRAYREF,
 414                                                         optional => 1,
 415                                                        },
 416                                           submitter => {type => SCALAR|ARRAYREF,
 417                                                         optional => 1,
 418                                                        },
 419                                           severity  => {type => SCALAR|ARRAYREF,
 420                                                         optional => 1,
 421                                                        },
 422                                           status    => {type => SCALAR|ARRAYREF,
 423                                                         optional => 1,
 424                                                        },
 425                                           tag       => {type => SCALAR|ARRAYREF,
 426                                                         optional => 1,
 427                                                        },
 428 # not yet supported
 429 #                                         owner     => {type => SCALAR|ARRAYREF,
 430 #                                                       optional => 1,
 431 #                                                      },
 432 #                                         dist      => {type => SCALAR|ARRAYREF,
 433 #                                                       optional => 1,
 434 #                                                      },
 435                                           archive   => {type => BOOLEAN,
 436                                                         default => 1,
 437                                                        },
 438                                           usertags  => {type => HASHREF,
 439                                                         optional => 1,
 440                                                        },
 441                                           function  => {type => CODEREF,
 442                                                         optional => 1,
 443                                                        },
 444                                          },
 445                               );
 446      my $flatfile;
 447      if ($param{archive}) {
 448           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
 449                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
 450      }
 451      else {
 452           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
 453                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
 454      }
 455      my %usertag_bugs;
 456      if (exists $param{tag} and exists $param{usertags}) {
 457           # This complex slice makes a hash with the bugs which have the
 458           # usertags passed in $param{tag} set.
 459           @usertag_bugs{make_list(@{$param{usertags}}{make_list($param{tag})})
 460                         } = (1) x make_list(@{$param{usertags}}{make_list($param{tag})});
 461      }
 462      # We handle src packages, maint and maintenc by mapping to the
 463      # appropriate binary packages, then removing all packages which
 464      # don't match all queries
 465      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 466                                                qw(package src maint)
 467                                               );
 468      if (exists $param{package} or
 469          exists $param{src} or
 470          exists $param{maint}) {
 471           delete @param{qw(maint src)};
 472           $param{package} = [@packages];
 473      }
 474      my @bugs;
 475      while (<$flatfile>) {
 476           next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
 477           my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
 478           next if exists $param{bugs} and not grep {$bug == $_} make_list($param{bugs});
 479           if (exists $param{package}) {
 480                my @packages = splitpackages($pkg);
 481                next unless grep { my $pkg_list = $_;
 482                                   grep {$pkg_list eq $_} make_list($param{package})
 483                              } @packages;
 484           }
 485           if (exists $param{src}) {
 486                my @src_packages = map { getsrcpkgs($_)} make_list($param{src});
 487                my @packages = splitpackages($pkg);
 488                next unless grep { my $pkg_list = $_;
 489                                   grep {$pkg_list eq $_} @packages
 490                              } @src_packages;
 491           }
 492           if (exists $param{submitter}) {
 493                my @p_addrs = map {lc($_->address)}
 494                     map {getparsedaddrs($_)}
 495                          make_list($param{submitter});
 496                my @f_addrs = map {$_->address}
 497                     getparsedaddrs($submitter||'');
 498                next unless grep { my $f_addr = $_;
 499                                   grep {$f_addr eq $_} @p_addrs
 500                              } @f_addrs;
 501           }
 502           next if exists $param{severity} and not grep {$severity eq $_} make_list($param{severity});
 503           next if exists $param{status} and not grep {$status eq $_} make_list($param{status});
 504           if (exists $param{tag}) {
 505                my $bug_ok = 0;
 506                # either a normal tag, or a usertag must be set
 507                $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
 508                my @bug_tags = split ' ', $tags;
 509                $bug_ok = 1 if grep {my $bug_tag = $_;
 510                                     grep {$bug_tag eq $_} make_list($param{tag});
 511                                } @bug_tags;
 512                next unless $bug_ok;
 513           }
 514           # We do this last, because a function may be slow...
 515           if (exists $param{function}) {
 516                my @bug_tags = split ' ', $tags;
 517                my @packages = splitpackages($pkg);
 518                my $package = (@packages > 1)?\@packages:$packages[0];
 519                next unless
 520                     $param{function}->(pkg       => $package,
 521                                        bug       => $bug,
 522                                        status    => $status,
 523                                        submitter => $submitter,
 524                                        severity  => $severity,
 525                                        tags      => \@bug_tags,
 526                                       );
 527           }
 528           push @bugs, $bug;
 529      }
 530      return @bugs;
 531 }
 532
 533 sub __handle_pkg_src_and_maint{
 534      my %param = validate_with(params => \@_,
 535                                spec   => {package   => {type => SCALAR|ARRAYREF,
 536                                                         optional => 1,
 537                                                        },
 538                                           src       => {type => SCALAR|ARRAYREF,
 539                                                         optional => 1,
 540                                                        },
 541                                           maint     => {type => SCALAR|ARRAYREF,
 542                                                         optional => 1,
 543                                                        },
 544                                          },
 545                                allow_extra => 1,
 546                               );
 547
 548      my @packages;
 549      @packages = make_list($param{package}) if exists $param{package};
 550      my $package_keys = @packages?1:0;
 551      my %packages;
 552      @packages{@packages} = (1) x @packages;
 553      if (exists $param{src}) {
 554           # We only want to increment the number of keys if there is
 555           # something to match
 556           my $key_inc = 0;
 557           for my $package ((map { getsrcpkgs($_)} make_list($param{src})),make_list($param{src})) {
 558                $packages{$package}++;
 559                $key_inc=1;
 560           }
 561           $package_keys += $key_inc;
 562      }
 563      if (exists $param{maint}) {
 564           my $key_inc = 0;
 565           my $maint_rev = getmaintainers_reverse();
 566           for my $package (map { exists $maint_rev->{$_}?@{$maint_rev->{$_}}:()}
 567                            make_list($param{maint})) {
 568                $packages{$package}++;
 569                $key_inc = 1;
 570           }
 571           $package_keys += $key_inc;
 572      }
 573      return grep {$packages{$_} >= $package_keys} keys %packages;
 574 }
 575
 576
 577 1;
 578
 579 __END__