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