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