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