3 # Generates by-*.idx files for the CGI scripts
4 # Copyright (c) 2005/08/03 Anthony Towns
8 use MLDBM qw(DB_FILE Storable);
9 use Fcntl qw/O_RDWR O_CREAT O_TRUNC/;
19 use List::Util qw(min);
23 gen-indices - Generates index files for the cgi scripts
30 --index-path path to index location
31 --quick update changed bugs
32 --debug, -d debugging level (Default 0)
33 --help, -h display this help
34 --man, -m display manual
42 Only update changed bugs
46 Debug verbosity. (Default 0)
50 Display brief useage information.
63 # Use portable Storable images
64 $MLDBM::DumpMeth=q(portable);
67 my %options = (debug => 0,
74 GetOptions(\%options,'quick!','index_path|index-path=s','debug|d+','help|h|?','man|m') or pod2usage(2);
75 pod2usage(1) if $options{help};
76 pod2usage(-verbose=>2) if $options{man};
78 use Debbugs::Config qw(:config);
79 use Debbugs::Common qw(getparsedaddrs getbugcomponent);
80 use Debbugs::Status qw(readbug);
82 chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
84 my $verbose = $options{debug};
85 my $indexdest = $options{index_path} || $config{spool_dir};
87 my $initialdir = "db-h";
90 if (defined $ARGV[0] and $ARGV[0] eq "archive") {
91 $initialdir = "archive";
95 # NB: The reverse index is special; it's used to clean up during updates to bugs
96 my @indexes = ('package', 'tag', 'severity','owner','submitter-email','reverse');
100 if (not $options{quick}) {
101 # We'll trade memory for speed here if we're not doing a quick rebuild
102 for my $indexes (@indexes) {
103 $fast_index{$indexes} = {};
105 $indexes = \%fast_index;
108 $indexes = \%slow_index;
111 my $start_time = time;
112 for my $i (@indexes) {
113 $slow_index{$i} = {};
114 if ($options{quick}) {
115 if (-e "$indexdest/by-$i${suffix}.idx") {
116 system('cp','-a',"$indexdest/by-$i${suffix}.idx","$indexdest/by-$i${suffix}.idx.new") == 0
117 or die "Error creating the new index";
118 my $stat = stat("$indexdest/by-$i${suffix}.idx") or die "Unable to stat $indexdest/by-$i${suffix}.idx";
119 $time = defined $time ? min($time,$stat->mtime) : $stat->mtime;
121 tie %{$slow_index{$i}}, MLDBM => "$indexdest/by-$i$suffix.idx.new",
123 or die "$0: can't create by-$i$suffix-idx.new: $!";
126 tie %{$slow_index{$i}}, MLDBM => "$indexdest/by-$i$suffix.idx.new",
127 O_RDWR|O_CREAT|O_TRUNC, 0666
128 or die "$0: can't create by-$i$suffix-idx.new: $!";
131 $time = 0 if not defined $time;
135 my ($index, $bug, @values) = @_;
137 if (exists $indexes->{reverse}{"$index $bug"}) {
138 # We do this insanity to work around a "feature" in MLDBM
139 for my $key (@{$indexes->{reverse}{"$index $bug"}}) {
140 my $temp = $indexes->{$index}{$key};
141 delete $temp->{$bug};
142 $indexes->{$index}{$key} = $temp;
143 $indexes->{$index}{"count $key"}--;
145 delete $indexes->{reverse}{"$index $bug"};
147 for my $key (@values) {
148 $indexes->{$index}->{"count $key"}++;
149 # We do this insanity to work around a "feature" in MLDBM
150 my $temp = $indexes->{$index}->{$key};
152 $indexes->{$index}->{$key} = $temp;
154 $indexes->{reverse}{"$index $bug"} = [@values];
157 sub emailfromrfc822 {
159 $email =~ s/\s*\(.*\)\s*//;
160 $email = $1 if ($email =~ m/<(.*)>/);
166 my @dirs = ($initialdir);
167 while (my $dir = shift @dirs) {
168 printf "Doing dir %s ...\n", $dir if $verbose;
170 opendir(DIR, "$dir/.") or die "opendir $dir: $!\n";
171 my @subdirs = readdir(DIR);
174 my @list = map { m/^(\d+)\.summary$/?($1):() } @subdirs;
175 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
177 for my $bug (@list) {
178 print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
179 my $stat = stat(getbugcomponent($bug,'summary'));
180 next if $stat->mtime < $time;
181 my $fdata = readbug($bug, $initialdir);
182 addbugtoindex("package", $bug, split /[\s,]+/, $fdata->{"package"});
183 addbugtoindex("tag", $bug, split /[\s,]+/, $fdata->{"keywords"});
184 addbugtoindex('submitter-email', $bug,
185 map {$_->address} getparsedaddrs($fdata->{originator}));
186 addbugtoindex("severity", $bug, $fdata->{"severity"});
187 addbugtoindex("owner", $bug, $fdata->{"owner"});
191 if (not $options{quick}) {
192 # put the fast index into the slow index
193 for my $key1 (keys %fast_index) {
194 for my $key2 (keys %{$fast_index{$key1}}) {
195 $slow_index{$key1}{$key2} = $fast_index{$key1}{$key2};
197 print "Dealt with index $key1\n" if $verbose;
202 for my $i (@indexes) {
203 untie %{$slow_index{$i}};
204 move("$indexdest/by-$i$suffix.idx.new", "$indexdest/by-$i$suffix.idx");
205 # We do this, because old versions of touch don't support -d '@epoch'
206 system('touch','-d',"1/1/1970 UTC + ${start_time}secs","$indexdest/by-$i$suffix.idx");