scripts/gen-indices.in

   1 #!/usr/bin/perl
   2
   3 # Generates by-*.idx files for the CGI scripts
   4 # Copyright (c) 2005/08/03 Anthony Towns
   5 # GPL v2
   6
   7 #use strict;
   8
   9 use DB_File;
  10 use MLDBM qw(DB_FILE Storable);
  11 use Fcntl qw/O_RDWR O_CREAT O_TRUNC/;
  12 use File::Copy;
  13
  14 use Getopt::Long;
  15 use Pod::Usage;
  16
  17 use warnings;
  18 use strict;
  19
  20 use File::stat;
  21 use List::Util qw(min);
  22
  23 =head1 NAME
  24
  25 gen-indices - Generates index files for the cgi scripts
  26
  27 =head1 SYNOPSIS
  28
  29  gen-indices [options]
  30
  31  Options:
  32   --index-path path to index location
  33   --quick update changed bugs
  34   --debug, -d debugging level (Default 0)
  35   --help, -h display this help
  36   --man, -m display manual
  37
  38 =head1 OPTIONS
  39
  40 =over
  41
  42 =itme B<--quick>
  43
  44 Only update changed bugs
  45
  46 =item B<--debug, -d>
  47
  48 Debug verbosity. (Default 0)
  49
  50 =item B<--help, -h>
  51
  52 Display brief useage information.
  53
  54 =item B<--man, -m>
  55
  56 Display this manual.
  57
  58 =back
  59
  60 =head1 EXAMPLES
  61
  62
  63 =cut
  64
  65 # Use portable Storable images
  66 $MLDBM::DumpMeth=q(portable);
  67
  68
  69 my %options = (debug           => 0,
  70                help            => 0,
  71                man             => 0,
  72                quick           => 0,
  73                index_path      => undef,
  74                );
  75
  76 GetOptions(\%options,'quick!','index_path|index-path=s','debug|d+','help|h|?','man|m') or pod2usage(2);
  77 pod2usage(1) if $options{help};
  78 pod2usage(-verbose=>2) if $options{man};
  79
  80 { no warnings;
  81   no strict;
  82 require '/etc/debbugs/config';
  83 require '/org/bugs.debian.org/scripts/errorlib';
  84 }
  85
  86 chdir('/org/bugs.debian.org/spool') or die "chdir spool: $!\n";
  87
  88 my $verbose = $options{debug};
  89 my $indexdest = $options{index_path} || "/org/bugs.debian.org/spool";
  90
  91 my $initialdir = "db-h";
  92 my $suffix = "";
  93
  94 if (defined $ARGV[0] and $ARGV[0] eq "archive") {
  95     $initialdir = "archive";
  96     $suffix = "-arc";
  97 }
  98
  99 # NB: The reverse index is special; it's used to clean up during updates to bugs
 100 my @indexes = ('package', 'tag', 'severity', 'submitter-email','reverse');
 101 my $indexes;
 102 my %slow_index = ();
 103 my %fast_index = ();
 104 if (not $options{quick}) {
 105      # We'll trade memory for speed here if we're not doing a quick rebuild
 106      for my $indexes (@indexes) {
 107           $fast_index{$indexes} = {};
 108      }
 109      $indexes = \%fast_index;
 110 }
 111 else {
 112      $indexes = \%slow_index;
 113 }
 114 my $time = undef;
 115 my $start_time = time;
 116 for my $i (@indexes) {
 117         $slow_index{$i} = {};
 118         if ($options{quick}) {
 119              if (-e "$indexdest/by-$i${suffix}.idx") {
 120                   system('cp','-a',"$indexdest/by-$i${suffix}.idx","$indexdest/by-$i${suffix}.idx.new") == 0
 121                        or die "Error creating the new index";
 122                   my $stat = stat("$indexdest/by-$i${suffix}.idx") or die "Unable to stat $indexdest/by-$i${suffix}.idx";
 123                   $time = defined $time ? min($time,$stat->mtime) : $stat->mtime;
 124              }
 125              tie %{$slow_index{$i}}, MLDBM => "$indexdest/by-$i$suffix.idx.new",
 126                   O_RDWR|O_CREAT, 0666
 127                        or die "$0: can't create by-$i$suffix-idx.new: $!";
 128         }
 129         else {
 130              tie %{$slow_index{$i}}, MLDBM => "$indexdest/by-$i$suffix.idx.new",
 131                   O_RDWR|O_CREAT|O_TRUNC, 0666
 132                        or die "$0: can't create by-$i$suffix-idx.new: $!";
 133
 134         }
 135         $time = 0 if not defined $time;
 136 }
 137
 138 sub addbugtoindex {
 139      my ($index, $bug, @values) = @_;
 140
 141      if (exists $indexes->{reverse}{"$index $bug"}) {
 142           # We do this insanity to work around a "feature" in MLDBM
 143           for my $key (@{$indexes->{reverse}{"$index $bug"}}) {
 144                my $temp = $indexes->{$index}{$key};
 145                delete $temp->{$bug};
 146                $indexes->{$index}{$key} = $temp;
 147                $indexes->{$index}{"count $key"}--;
 148           }
 149           delete $indexes->{reverse}{"$index $bug"};
 150      }
 151      for my $key (@values) {
 152           $indexes->{$index}->{"count $key"}++;
 153           # We do this insanity to work around a "feature" in MLDBM
 154           my $temp = $indexes->{$index}->{$key};
 155           $temp->{$bug} = 1;
 156           $indexes->{$index}->{$key} = $temp;
 157      }
 158      $indexes->{reverse}{"$index $bug"} = [@values];
 159 }
 160
 161 sub emailfromrfc822 {
 162         my $email = shift;
 163         $email =~ s/\s*\(.*\)\s*//;
 164         $email = $1 if ($email =~ m/<(.*)>/);
 165         return $email;
 166 }
 167
 168 my $cnt = 0;
 169
 170 my @dirs = ($initialdir);
 171 while (my $dir = shift @dirs) {
 172         printf "Doing dir %s ...\n", $dir if $verbose;
 173
 174         opendir(DIR, "$dir/.") or die "opendir $dir: $!\n";
 175         my @subdirs = readdir(DIR);
 176         closedir(DIR);
 177
 178         my @list = map { m/^(\d+)\.summary$/?($1):() } @subdirs;
 179         push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
 180
 181         for my $bug (@list) {
 182                 print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
 183                 my $stat = stat(getbugcomponent($bug,'summary'));
 184                 next if $stat->mtime < $time;
 185                 my $fdata = readbug($bug, $initialdir);
 186                 addbugtoindex("package", $bug, split /[\s,]+/, $fdata->{"package"});
 187                 addbugtoindex("tag", $bug, split /[\s,]+/, $fdata->{"keywords"});
 188                 addbugtoindex('submitter-email', $bug,
 189                               emailfromrfc822($fdata->{"originator"}));
 190                 addbugtoindex("severity", $bug, $fdata->{"severity"});
 191         }
 192 }
 193
 194 if (not $options{quick}) {
 195      # put the fast index into the slow index
 196      for my $key1 (keys %fast_index) {
 197           for my $key2 (keys %{$fast_index{$key1}}) {
 198                $slow_index{$key1}{$key2} = $fast_index{$key1}{$key2};
 199           }
 200           print "Dealt with index $key1\n" if $verbose;
 201      }
 202 }
 203
 204
 205 for my $i (@indexes) {
 206         untie %{$slow_index{$i}};
 207         move("$indexdest/by-$i$suffix.idx.new", "$indexdest/by-$i$suffix.idx");
 208         # We do this, because old versions of touch don't support -d '@epoch'
 209         system('touch','-d',"1/1/1970 UTC + ${start_time}secs","$indexdest/by-$i$suffix.idx");
 210 }
 211