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