Count the results on the direct lookup too
[debian-cd-search.git] / update-lists-db.pl
1 #!/usr/bin/perl -w
2 #
3 # update-lists-db.pl
4 #
5 # Parse the list.gz files that are created on cdimage.debian.org and
6 # convert the contents into a dbm file for lookup tools to use.
7
8 # Copyright (c) 2011 Steve McIntyre <93sam@debian.org>
9
10 # This program is free software; you can redistribute it and/or modify
11 # it under the terms of the GNU General Public License as published by
12 # the Free Software Foundation; either version 2 of the License, or
13 # (at your option) any later version.
14 #
15 # This program is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 # GNU General Public License for more details.
19 #
20 # You should have received a copy of the GNU General Public License
21 # along with this program; if not, write to the Free Software
22 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
23
24 use strict;
25 use Fcntl qw(:flock SEEK_END);
26 use File::stat;
27 use File::Find;
28 use File::Basename;
29 use Compress::Zlib;
30 use POSIX qw(ENOENT EROFS ENOSYS EEXIST EPERM EBUSY O_RDONLY O_RDWR O_APPEND O_CREAT);
31 use Fcntl qw(O_RDWR O_WRONLY);
32 use DB_File;
33
34 my $dbdir = "/home/debian-cd/search-db";
35 my $lock = "$dbdir/.update.lock";
36 my @areas = qw(daily-builds release weekly-builds archive);
37 #my @areas = qw(weekly-builds);
38 my $update_needed = 0;
39 my $num_list_files;
40 my $db_mtime = 0;
41 my $db_file_name;
42 my $list_file_name;
43 my $list_file;
44 my $verbose = 0;
45
46 while (1) {
47     my $arg = shift;
48     if (!defined($arg)) {
49         last;
50     }
51     if ("-v" eq $arg) {
52         $verbose++;
53     }
54 }
55
56 sub print_log {
57     my $level = shift;
58     my $msg = shift;
59     if ($level <= $verbose) {
60         print $msg;
61     }
62 }
63
64 sub lock {
65     my ($fh) = @_;
66     flock($fh, LOCK_EX) or die "Cannot lock lockfile - $!\n";
67     
68     # and, in case someone appended while we were waiting...
69     seek($fh, 0, SEEK_END) or die "Cannot seek - $!\n";
70 }
71
72 sub unlock {
73     my ($fh) = @_;
74     flock($fh, LOCK_UN) or die "Cannot unlock lockfile - $!\n";
75 }
76
77 sub file_mtime {
78     my ($file) = shift;
79     my $sb = lstat($file);
80     if (! -e $file) {
81         print "ENOENT $file!\n";
82     }
83     return $sb->mtime;
84 }
85
86 sub check_newer {
87     my ($filename);
88     $filename = $File::Find::name;
89     if ($filename =~ m/\.list\.gz$/) {
90         my $mtime = file_mtime("/mnt/nfs-cdimage/$filename");
91         print_log(4, "  check_newer: found $filename\n");
92         print LISTS "$filename\n";
93         if ($mtime > $db_mtime) {
94             $update_needed = 1;
95         }
96         $num_list_files++;
97         if (!($num_list_files % 1000)) {
98             print_log(3, "  check_newer: found $num_list_files list files\n");
99         }
100     }
101 }
102
103 chdir "/mnt/nfs-cdimage";
104
105 open(my $lockfile, ">>", "$lock") or die "Can't open lockfile: $!";
106 print_log(1, "waiting on lock for $lock\n");
107 lock($lockfile);
108 print_log(1, "lock acquired for $lock\n");
109
110 foreach my $area (@areas) {
111     $update_needed = 0;
112     $num_list_files = 0;
113     $db_file_name = "$dbdir/$area.db";
114     $list_file_name = "$dbdir/$area.lists";
115
116     print_log(1, "Working on area $area:\n");
117     unlink "$list_file_name.new";
118     open(LISTS, ">> $list_file_name.new") or die ("Can't open lists file $list_file_name.new for writing: $!\n");
119     if (-f $db_file_name) {
120         $db_mtime = file_mtime($db_file_name);
121     } else {
122         $db_mtime = 0;
123     }
124     find (\&check_newer,  "$area");
125     close LISTS;
126     print_log(2, "  found $num_list_files list files total, update_needed $update_needed\n");
127
128     if ($update_needed) {
129         my $current_list_num = 0;
130         my $num_files = 0;
131         my $current_file = 0;
132         my $unique_files = 0;
133         my %fileinfo;
134         my %dbinfo;
135
136         # Two passes; work in memory first, then push to the DB
137         # file. Will this work better?
138         undef %fileinfo;
139         undef %dbinfo;
140
141         unlink "$db_file_name.new";
142
143         open(LISTS, "< $list_file_name.new") or die ("Can't open lists file $list_file_name.new for reading: $!\n");
144         while (my $listfile = <LISTS>) {
145             $current_list_num++;
146             chomp $listfile;
147             my $gz = gzopen($listfile, "rb") or die "Cannot open $listfile: $gzerrno\n";
148             my $file;
149             while ($gz->gzreadline($file) > 0) {
150                 chomp $file;
151                 $num_files++;
152                 if (defined($fileinfo{$file})) {
153                     $fileinfo{$file} = "$fileinfo{$file} $listfile";
154                 } else {
155                     $fileinfo{$file} = "$listfile";
156                     $unique_files++;
157                 }
158             }
159             $gz->gzclose();
160             if (!($current_list_num % 100)) {
161                 print_log(3, "    processing $area in memory: $current_list_num/$num_list_files list files done, $num_files files ($unique_files unique)\n");
162             }
163         }
164
165         # now push to the db
166         tie %dbinfo, 'DB_File', "$db_file_name.new";
167         foreach my $file (keys %fileinfo) {
168             $dbinfo{$file} = $fileinfo{$file};      
169             $current_file++;
170             if (!($current_file % 10000)) {
171                 print_log(3, "    storing $area to db: $current_file/$unique_files files added\n");
172             }
173         }
174         untie %dbinfo;
175         
176         rename("$db_file_name.new", "$db_file_name");
177         print_log(2, "  $db_file_name created: $num_list_files list files, $num_files files referenced\n");
178     }
179     rename("$list_file_name.new", "$list_file_name");
180 }
181 print_log(1, "dropping lock for $lock\n");
182 unlock($lockfile);
183 close($lockfile);