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));
  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);
  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
 269 =head2 get_bugs_by_idx
 270
 271 This routine uses the by-$index.idx indicies to try to speed up
 272 searches.
 273
 274
 275 =cut
 276
 277 sub get_bugs_by_idx{
 278      my %param = validate_with(params => \@_,
 279                                spec   => {package   => {type => SCALAR|ARRAYREF,
 280                                                         optional => 1,
 281                                                        },
 282                                           submitter => {type => SCALAR|ARRAYREF,
 283                                                         optional => 1,
 284                                                        },
 285                                           severity  => {type => SCALAR|ARRAYREF,
 286                                                         optional => 1,
 287                                                        },
 288                                           tag       => {type => SCALAR|ARRAYREF,
 289                                                         optional => 1,
 290                                                        },
 291                                           archive   => {type => BOOLEAN,
 292                                                         default => 0,
 293                                                        },
 294                                           owner     => {type => SCALAR|ARRAYREF,
 295                                                         optional => 1,
 296                                                        },
 297                                           src       => {type => SCALAR|ARRAYREF,
 298                                                         optional => 1,
 299                                                        },
 300                                           maint     => {type => SCALAR|ARRAYREF,
 301                                                         optional => 1,
 302                                                        },
 303                                          },
 304                               );
 305      my %bugs = ();
 306
 307      # We handle src packages, maint and maintenc by mapping to the
 308      # appropriate binary packages, then removing all packages which
 309      # don't match all queries
 310      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 311                                                qw(package src maint)
 312                                               );
 313      if (exists $param{package} or
 314          exists $param{src} or
 315          exists $param{maint}) {
 316           delete @param{qw(maint src)};
 317           $param{package} = [@packages];
 318      }
 319      my $keys = keys(%param) - 1;
 320      die "Need at least 1 key to search by" unless $keys;
 321      my $arc = $param{archive} ? '-arc':'';
 322      my %idx;
 323      for my $key (grep {$_ ne 'archive'} keys %param) {
 324           my $index = $key;
 325           $index = 'submitter-email' if $key eq 'submitter';
 326           $index = "$config{spool_dir}/by-${index}${arc}.idx";
 327           tie(%idx, MLDBM => $index, O_RDONLY)
 328                or die "Unable to open $index: $!";
 329           for my $search (__make_list($param{$key})) {
 330                next unless defined $idx{$search};
 331                for my $bug (keys %{$idx{$search}}) {
 332                     # increment the number of searches that this bug matched
 333                     $bugs{$bug}++;
 334                }
 335           }
 336           untie %idx or die 'Unable to untie %idx';
 337      }
 338      # Throw out results that do not match all of the search specifications
 339      return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
 340 }
 341
 342
 343 =head2 get_bugs_flatfile
 344
 345 This is the fallback search routine. It should be able to complete all
 346 searches. [Or at least, that's the idea.]
 347
 348 =cut
 349
 350 sub get_bugs_flatfile{
 351      my %param = validate_with(params => \@_,
 352                                spec   => {package   => {type => SCALAR|ARRAYREF,
 353                                                         optional => 1,
 354                                                        },
 355                                           src       => {type => SCALAR|ARRAYREF,
 356                                                         optional => 1,
 357                                                        },
 358                                           maint     => {type => SCALAR|ARRAYREF,
 359                                                         optional => 1,
 360                                                        },
 361                                           submitter => {type => SCALAR|ARRAYREF,
 362                                                         optional => 1,
 363                                                        },
 364                                           severity  => {type => SCALAR|ARRAYREF,
 365                                                         optional => 1,
 366                                                        },
 367                                           status    => {type => SCALAR|ARRAYREF,
 368                                                         optional => 1,
 369                                                        },
 370                                           tag       => {type => SCALAR|ARRAYREF,
 371                                                         optional => 1,
 372                                                        },
 373 # not yet supported
 374 #                                         owner     => {type => SCALAR|ARRAYREF,
 375 #                                                       optional => 1,
 376 #                                                      },
 377 #                                         dist      => {type => SCALAR|ARRAYREF,
 378 #                                                       optional => 1,
 379 #                                                      },
 380                                           archive   => {type => BOOLEAN,
 381                                                         default => 1,
 382                                                        },
 383                                           usertags  => {type => HASHREF,
 384                                                         optional => 1,
 385                                                        },
 386                                           function  => {type => CODEREF,
 387                                                         optional => 1,
 388                                                        },
 389                                          },
 390                               );
 391      my $flatfile;
 392      if ($param{archive}) {
 393           $flatfile = IO::File->new("$config{spool_dir}/index.archive", 'r')
 394                or die "Unable to open $config{spool_dir}/index.archive for reading: $!";
 395      }
 396      else {
 397           $flatfile = IO::File->new("$config{spool_dir}/index.db", 'r')
 398                or die "Unable to open $config{spool_dir}/index.db for reading: $!";
 399      }
 400      my %usertag_bugs;
 401      if (exists $param{tag} and exists $param{usertags}) {
 402
 403           # This complex slice makes a hash with the bugs which have the
 404           # usertags passed in $param{tag} set.
 405           @usertag_bugs{map {@{$_}}
 406                              @{$param{usertags}}{__make_list($param{tag})}
 407                         } = (1) x @{$param{usertags}}{__make_list($param{tag})}
 408      }
 409      # We handle src packages, maint and maintenc by mapping to the
 410      # appropriate binary packages, then removing all packages which
 411      # don't match all queries
 412      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 413                                                qw(package src maint)
 414                                               );
 415      if (exists $param{package} or
 416          exists $param{src} or
 417          exists $param{maint}) {
 418           delete @param{qw(maint src)};
 419           $param{package} = [@packages];
 420      }
 421      my @bugs;
 422      while (<$flatfile>) {
 423           next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
 424           my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
 425           next if exists $param{bugs} and not grep {$bug == $_} __make_list($param{bugs});
 426           if (exists $param{package}) {
 427                my @packages = splitpackages($pkg);
 428                next unless grep { my $pkg_list = $_;
 429                                   grep {$pkg_list eq $_} __make_list($param{package})
 430                              } @packages;
 431           }
 432           if (exists $param{src}) {
 433                my @src_packages = map { getsrcpkgs($_)} __make_list($param{src});
 434                my @packages = splitpackages($pkg);
 435                next unless grep { my $pkg_list = $_;
 436                                   grep {$pkg_list eq $_} @packages
 437                              } @src_packages;
 438           }
 439           if (exists $param{submitter}) {
 440                my @p_addrs = map {lc($_->address)}
 441                     map {getparsedaddrs($_)}
 442                          __make_list($param{submitter});
 443                my @f_addrs = map {$_->address}
 444                     getparsedaddrs($submitter||'');
 445                next unless grep { my $f_addr = $_;
 446                                   grep {$f_addr eq $_} @p_addrs
 447                              } @f_addrs;
 448           }
 449           next if exists $param{severity} and not grep {$severity eq $_} __make_list($param{severity});
 450           next if exists $param{status} and not grep {$status eq $_} __make_list($param{status});
 451           if (exists $param{tag}) {
 452                my $bug_ok = 0;
 453                # either a normal tag, or a usertag must be set
 454                $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
 455                my @bug_tags = split ' ', $tags;
 456                $bug_ok = 1 if grep {my $bug_tag = $_;
 457                                     grep {$bug_tag eq $_} __make_list($param{tag});
 458                                } @bug_tags;
 459                next unless $bug_ok;
 460           }
 461           # We do this last, because a function may be slow...
 462           if (exists $param{function}) {
 463                my @bug_tags = split ' ', $tags;
 464                my @packages = splitpackages($pkg);
 465                my $package = (@packages > 1)?\@packages:$packages[0];
 466                next unless
 467                     $param{function}->(pkg       => $package,
 468                                        bug       => $bug,
 469                                        status    => $status,
 470                                        submitter => $submitter,
 471                                        severity  => $severity,
 472                                        tags      => \@bug_tags,
 473                                       );
 474           }
 475           push @bugs, $bug;
 476      }
 477      return @bugs;
 478 }
 479
 480 sub __handle_pkg_src_and_maint{
 481      my %param = validate_with(params => \@_,
 482                                spec   => {package   => {type => SCALAR|ARRAYREF,
 483                                                         optional => 1,
 484                                                        },
 485                                           src       => {type => SCALAR|ARRAYREF,
 486                                                         optional => 1,
 487                                                        },
 488                                           maint     => {type => SCALAR|ARRAYREF,
 489                                                         optional => 1,
 490                                                        },
 491                                          },
 492                                allow_extra => 1,
 493                               );
 494
 495      my @packages = __make_list($param{package});
 496      my $package_keys = @packages?1:0;
 497      my %packages;
 498      @packages{@packages} = (1) x @packages;
 499      if (exists $param{src}) {
 500           # We only want to increment the number of keys if there is
 501           # something to match
 502           my $key_inc = 0;
 503           for my $package ((map { getsrcpkgs($_)} __make_list($param{src})),__make_list($param{src})) {
 504                $packages{$package}++;
 505                $key_inc=1;
 506           }
 507           $package_keys += $key_inc;
 508      }
 509      if (exists $param{maint}) {
 510           my $key_inc = 0;
 511           my $maint_rev = getmaintainers_reverse();
 512           for my $package (map { exists $maint_rev->{$_}?@{$maint_rev->{$_}}:()}
 513                            __make_list($param{maint})) {
 514                $packages{$package}++;
 515                $key_inc = 1;
 516           }
 517           $package_keys += $key_inc;
 518      }
 519      return grep {$packages{$_} >= $package_keys} keys %packages;
 520 }
 521
 522
 523 # This private subroutine takes a scalar and turns it into a list;
 524 # transforming arrayrefs into their contents along the way. It also
 525 # turns undef into the empty list.
 526 sub __make_list{
 527      return map {defined $_?(ref($_) eq 'ARRAY'?@{$_}:$_):()} @_;
 528 }
 529
 530 1;
 531
 532 __END__