Debbugs/Bugs.pm

   1
   2 package Debbugs::Bugs;
   3
   4 =head1 NAME
   5
   6 Debbugs::Bugs -- Bug selection routines for debbugs
   7
   8 =head1 SYNOPSIS
   9
  10 use Debbugs::Bugs qw(get_bugs);
  11
  12
  13 =head1 DESCRIPTION
  14
  15 This module is a replacement for all of the various methods of
  16 selecting different types of bugs.
  17
  18 It implements a single function, get_bugs, which defines the master
  19 interface for selecting bugs.
  20
  21 It attempts to use subsidiary functions to actually do the selection,
  22 in the order specified in the configuration files. [Unless you're
  23 insane, they should be in order from fastest (and often most
  24 incomplete) to slowest (and most complete).]
  25
  26 =head1 BUGS
  27
  28 =head1 FUNCTIONS
  29
  30 =cut
  31
  32 use warnings;
  33 use strict;
  34 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  35 use base qw(Exporter);
  36
  37 BEGIN{
  38      $VERSION = 1.00;
  39      $DEBUG = 0 unless defined $DEBUG;
  40
  41      @EXPORT = ();
  42      %EXPORT_TAGS = ();
  43      @EXPORT_OK = (qw(get_bugs));
  44      $EXPORT_TAGS{all} = [@EXPORT_OK];
  45 }
  46
  47 use Debbugs::Config qw(:config);
  48 use Params::Validate qw(validate_with :types);
  49 use IO::File;
  50 use Debbugs::Status qw(splitpackages);
  51 use Debbugs::Packages qw(getsrcpkgs);
  52 use Debbugs::Common qw(getparsedaddrs getmaintainers getmaintainers_reverse);
  53 use Fcntl qw(O_RDONLY);
  54 use MLDBM qw(DB_File Storable);
  55
  56 =head2 get_bugs
  57
  58      get_bugs()
  59
  60 =head3 Parameters
  61
  62 The following parameters can either be a single scalar or a reference
  63 to an array. The parameters are ANDed together, and the elements of
  64 arrayrefs are a parameter are ORed. Future versions of this may allow
  65 for limited regular expressions, and/or more complex expressions.
  66
  67 =over
  68
  69 =item package -- name of the binary package
  70
  71 =item src -- name of the source package
  72
  73 =item maint -- address of the maintainer
  74
  75 =item submitter -- address of the submitter
  76
  77 =item severity -- severity of the bug
  78
  79 =item status -- status of the bug
  80
  81 =item tag -- bug tags
  82
  83 =item owner -- owner of the bug
  84
  85 =item dist -- distribution (I don't know about this one yet)
  86
  87 =item bugs -- list of bugs to search within
  88
  89 =item function -- see description below
  90
  91 =back
  92
  93 =head3 Special options
  94
  95 The following options are special options used to modulate how the
  96 searches are performed.
  97
  98 =over
  99
 100 =item archive -- whether to search archived bugs or normal bugs;
 101 defaults to false.
 102
 103 =item usertags -- set of usertags and the bugs they are applied to
 104
 105 =back
 106
 107
 108 =head3 Subsidiary routines
 109
 110 All subsidiary routines get passed exactly the same set of options as
 111 get_bugs. If for some reason they are unable to handle the options
 112 passed (for example, they don't have the right type of index for the
 113 type of selection) they should die as early as possible. [Using
 114 Params::Validate and/or die when files don't exist makes this fairly
 115 trivial.]
 116
 117 This function will then immediately move on to the next subroutine,
 118 giving it the same arguments.
 119
 120 =head3 function
 121
 122 This option allows you to provide an arbitrary function which will be
 123 given the information in the index.db file. This will be super, super
 124 slow, so only do this if there's no other way to write the search.
 125
 126 You'll be given a list (which you can turn into a hash) like the
 127 following:
 128
 129  (pkg => ['a','b'], # may be a scalar (most common)
 130   bug => 1234,
 131   status => 'pending',
 132   submitter => 'boo@baz.com',
 133   severity => 'serious',
 134   tags => ['a','b','c'], # may be an empty arrayref
 135  )
 136
 137 The function should return 1 if the bug should be included; 0 if the
 138 bug should not.
 139
 140 =cut
 141
 142 sub get_bugs{
 143      my %param = validate_with(params => \@_,
 144                                spec   => {package   => {type => SCALAR|ARRAYREF,
 145                                                         optional => 1,
 146                                                        },
 147                                           src       => {type => SCALAR|ARRAYREF,
 148                                                         optional => 1,
 149                                                        },
 150                                           maint     => {type => SCALAR|ARRAYREF,
 151                                                         optional => 1,
 152                                                        },
 153                                           submitter => {type => SCALAR|ARRAYREF,
 154                                                         optional => 1,
 155                                                        },
 156                                           severity  => {type => SCALAR|ARRAYREF,
 157                                                         optional => 1,
 158                                                        },
 159                                           status    => {type => SCALAR|ARRAYREF,
 160                                                         optional => 1,
 161                                                        },
 162                                           tag       => {type => SCALAR|ARRAYREF,
 163                                                         optional => 1,
 164                                                        },
 165                                           owner     => {type => SCALAR|ARRAYREF,
 166                                                         optional => 1,
 167                                                        },
 168                                           dist      => {type => SCALAR|ARRAYREF,
 169                                                         optional => 1,
 170                                                        },
 171                                           function  => {type => CODEREF,
 172                                                         optional => 1,
 173                                                        },
 174                                           bugs      => {type => SCALAR|ARRAYREF,
 175                                                         optional => 1,
 176                                                        },
 177                                           archive   => {type => BOOLEAN,
 178                                                         default => 0,
 179                                                        },
 180                                           usertags  => {type => HASHREF,
 181                                                         optional => 1,
 182                                                        },
 183                                          },
 184                               );
 185
 186      # Normalize options
 187      my %options = %param;
 188      my @bugs;
 189      # A configuration option will set an array that we'll use here instead.
 190      for my $routine (qw(Debbugs::Bugs::get_bugs_by_idx Debbugs::Bugs::get_bugs_flatfile)) {
 191           my ($package) = $routine =~ m/^(.+)\:\:/;
 192           eval "use $package;";
 193           if ($@) {
 194                # We output errors here because using an invalid function
 195                # in the configuration file isn't something that should
 196                # be done.
 197                warn "use $package failed with $@";
 198                next;
 199           }
 200           @bugs = eval "${routine}(\%options)";
 201           if ($@) {
 202
 203                # We don't output errors here, because failure here
 204                # via die may be a perfectly normal thing.
 205                print STDERR "$@" if $DEBUG;
 206                next;
 207           }
 208           last;
 209      }
 210      # If no one succeeded, die
 211      if ($@) {
 212           die "$@";
 213      }
 214      return @bugs;
 215 }
 216
 217 =head2 get_bugs_by_idx
 218
 219 This routine uses the by-$index.idx indicies to try to speed up
 220 searches.
 221
 222
 223 =cut
 224
 225 sub get_bugs_by_idx{
 226      my %param = validate_with(params => \@_,
 227                                spec   => {package   => {type => SCALAR|ARRAYREF,
 228                                                         optional => 1,
 229                                                        },
 230                                           submitter => {type => SCALAR|ARRAYREF,
 231                                                         optional => 1,
 232                                                        },
 233                                           severity  => {type => SCALAR|ARRAYREF,
 234                                                         optional => 1,
 235                                                        },
 236                                           tag       => {type => SCALAR|ARRAYREF,
 237                                                         optional => 1,
 238                                                        },
 239                                           archive   => {type => BOOLEAN,
 240                                                         default => 0,
 241                                                        },
 242                                           owner     => {type => SCALAR|ARRAYREF,
 243                                                         optional => 1,
 244                                                        },
 245                                           src       => {type => SCALAR|ARRAYREF,
 246                                                         optional => 1,
 247                                                        },
 248                                           maint     => {type => SCALAR|ARRAYREF,
 249                                                         optional => 1,
 250                                                        },
 251                                          },
 252                               );
 253      my %bugs = ();
 254
 255      # We handle src packages, maint and maintenc by mapping to the
 256      # appropriate binary packages, then removing all packages which
 257      # don't match all queries
 258      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 259                                                qw(package src maint)
 260                                               );
 261      if (exists $param{package} or
 262          exists $param{src} or
 263          exists $param{maint}) {
 264           delete @param{qw(maint src)};
 265           $param{package} = [@packages];
 266      }
 267      my $keys = keys(%param) - 1;
 268      die "Need at least 1 key to search by" unless $keys;
 269      my $arc = $param{archive} ? '-arc':'';
 270      my %idx;
 271      for my $key (grep {$_ ne 'archive'} keys %param) {
 272           my $index = $key;
 273           $index = 'submitter-email' if $key eq 'submitter';
 274           $index = "$config{spool_dir}/by-${index}${arc}.idx";
 275           tie(%idx, MLDBM => $index, O_RDONLY)
 276                or die "Unable to open $index: $!";
 277           for my $search (__make_list($param{$key})) {
 278                next unless defined $idx{$search};
 279                for my $bug (keys %{$idx{$search}}) {
 280                     # increment the number of searches that this bug matched
 281                     $bugs{$bug}++;
 282                }
 283           }
 284           untie %idx or die 'Unable to untie %idx';
 285      }
 286      # Throw out results that do not match all of the search specifications
 287      return map {$keys <= $bugs{$_}?($_):()} keys %bugs;
 288 }
 289
 290
 291 =head2 get_bugs_flatfile
 292
 293 This is the fallback search routine. It should be able to complete all
 294 searches. [Or at least, that's the idea.]
 295
 296 =cut
 297
 298 sub get_bugs_flatfile{
 299      my %param = validate_with(params => \@_,
 300                                spec   => {package   => {type => SCALAR|ARRAYREF,
 301                                                         optional => 1,
 302                                                        },
 303                                           src       => {type => SCALAR|ARRAYREF,
 304                                                         optional => 1,
 305                                                        },
 306                                           maint     => {type => SCALAR|ARRAYREF,
 307                                                         optional => 1,
 308                                                        },
 309                                           submitter => {type => SCALAR|ARRAYREF,
 310                                                         optional => 1,
 311                                                        },
 312                                           severity  => {type => SCALAR|ARRAYREF,
 313                                                         optional => 1,
 314                                                        },
 315                                           status    => {type => SCALAR|ARRAYREF,
 316                                                         optional => 1,
 317                                                        },
 318                                           tag       => {type => SCALAR|ARRAYREF,
 319                                                         optional => 1,
 320                                                        },
 321 # not yet supported
 322 #                                         owner     => {type => SCALAR|ARRAYREF,
 323 #                                                       optional => 1,
 324 #                                                      },
 325 #                                         dist      => {type => SCALAR|ARRAYREF,
 326 #                                                       optional => 1,
 327 #                                                      },
 328                                           archive   => {type => BOOLEAN,
 329                                                         default => 1,
 330                                                        },
 331                                           usertags  => {type => HASHREF,
 332                                                         optional => 1,
 333                                                        },
 334                                           function  => {type => CODEREF,
 335                                                         optional => 1,
 336                                                        },
 337                                          },
 338                               );
 339      my $flatfile;
 340      if ($param{archive}) {
 341           $flatfile = new IO::File "$debbugs::gSpoolDir/index.archive", 'r'
 342                or die "Unable to open $debbugs::gSpoolDir/index.archive for reading: $!";
 343      }
 344      else {
 345           $flatfile = new IO::File "$debbugs::gSpoolDir/index.db", 'r'
 346                or die "Unable to open $debbugs::gSpoolDir/index.db for reading: $!";
 347      }
 348      my %usertag_bugs;
 349      if (exists $param{tag} and exists $param{usertags}) {
 350
 351           # This complex slice makes a hash with the bugs which have the
 352           # usertags passed in $param{tag} set.
 353           @usertag_bugs{map {@{$_}}
 354                              @{$param{usertags}}{__make_list($param{tag})}
 355                         } = (1) x @{$param{usertags}}{__make_list($param{tag})}
 356      }
 357      # We handle src packages, maint and maintenc by mapping to the
 358      # appropriate binary packages, then removing all packages which
 359      # don't match all queries
 360      my @packages = __handle_pkg_src_and_maint(map {exists $param{$_}?($_,$param{$_}):()}
 361                                                qw(package src maint)
 362                                               );
 363      if (exists $param{package} or
 364          exists $param{src} or
 365          exists $param{maint}) {
 366           delete @param{qw(maint src)};
 367           $param{package} = [@packages];
 368      }
 369      my @bugs;
 370      while (<$flatfile>) {
 371           next unless m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/;
 372           my ($pkg,$bug,$time,$status,$submitter,$severity,$tags) = ($1,$2,$3,$4,$5,$6,$7);
 373           next if exists $param{bug} and not grep {$bug == $_} __make_list($param{bugs});
 374           if (exists $param{pkg}) {
 375                my @packages = splitpackages($pkg);
 376                next unless grep { my $pkg_list = $_;
 377                                   grep {$pkg_list eq $_} __make_list($param{pkg})
 378                              } @packages;
 379           }
 380           if (exists $param{src}) {
 381                my @src_packages = map { getsrcpkgs($_)} __make_list($param{src});
 382                my @packages = splitpackages($pkg);
 383                next unless grep { my $pkg_list = $_;
 384                                   grep {$pkg_list eq $_} @packages
 385                              } @src_packages;
 386           }
 387           if (exists $param{submitter}) {
 388                my @p_addrs = map {lc($_->address)}
 389                     map {getparsedaddrs($_)}
 390                          __make_list($param{submitter});
 391                my @f_addrs = map {$_->address}
 392                     getparsedaddrs($submitter||'');
 393                next unless grep { my $f_addr = $_;
 394                                   grep {$f_addr eq $_} @p_addrs
 395                              } @f_addrs;
 396           }
 397           next if exists $param{severity} and not grep {$severity eq $_} __make_list($param{severity});
 398           next if exists $param{status} and not grep {$status eq $_} __make_list($param{status});
 399           if (exists $param{tag}) {
 400                my $bug_ok = 0;
 401                # either a normal tag, or a usertag must be set
 402                $bug_ok = 1 if exists $param{usertags} and $usertag_bugs{$bug};
 403                my @bug_tags = split ' ', $tags;
 404                $bug_ok = 1 if grep {my $bug_tag = $_;
 405                                     grep {$bug_tag eq $_} __make_list($param{tag});
 406                                } @bug_tags;
 407                next unless $bug_ok;
 408           }
 409           # We do this last, because a function may be slow...
 410           if (exists $param{function}) {
 411                my @bug_tags = split ' ', $tags;
 412                my @packages = splitpackages($pkg);
 413                my $package = (@packages > 1)?\@packages:$packages[0];
 414                next unless
 415                     $param{function}->(pkg       => $package,
 416                                        bug       => $bug,
 417                                        status    => $status,
 418                                        submitter => $submitter,
 419                                        severity  => $severity,
 420                                        tags      => \@bug_tags,
 421                                       );
 422           }
 423           push @bugs, $bug;
 424      }
 425      return @bugs;
 426 }
 427
 428 sub __handle_pkg_src_and_maint{
 429      my %param = validate_with(params => \@_,
 430                                spec   => {package   => {type => SCALAR|ARRAYREF,
 431                                                         optional => 1,
 432                                                        },
 433                                           src       => {type => SCALAR|ARRAYREF,
 434                                                         optional => 1,
 435                                                        },
 436                                           maint     => {type => SCALAR|ARRAYREF,
 437                                                         optional => 1,
 438                                                        },
 439                                          },
 440                                allow_extra => 1,
 441                               );
 442
 443      my @packages = __make_list($param{package});
 444      my $package_keys = @packages?1:0;
 445      my %packages;
 446      @packages{@packages} = (1) x @packages;
 447      if (exists $param{src}) {
 448           # We only want to increment the number of keys if there is
 449           # something to match
 450           my $key_inc = 0;
 451           for my $package ((map { getsrcpkgs($_)} __make_list($param{src})),__make_list($param{src})) {
 452                $packages{$package}++;
 453                $key_inc=1;
 454           }
 455           $package_keys += $key_inc;
 456      }
 457      if (exists $param{maint}) {
 458           my $key_inc = 0;
 459           my $maint_rev = getmaintainers_reverse();
 460           for my $package (map { exists $maint_rev->{$_}?@{$maint_rev->{$_}}:()}
 461                            __make_list($param{maint})) {
 462                $packages{$package}++;
 463                $key_inc = 1;
 464           }
 465           $package_keys += $key_inc;
 466      }
 467      return grep {$packages{$_} >= $package_keys} keys %packages;
 468 }
 469
 470
 471 # This private subroutine takes a scalar and turns it into a list;
 472 # transforming arrayrefs into their contents along the way. It also
 473 # turns undef into the empty list.
 474 sub __make_list{
 475      return map {defined $_?(ref($_) eq 'ARRAY'?@{$_}:$_):()} @_;
 476 }
 477
 478 1;
 479
 480 __END__