2 # debbugs-loadsql is part of debbugs, and is released
3 # under the terms of the GPL version 2, or any later version, at your
4 # option. See the file README and COPYING for more information.
5 # Copyright 2012 by Don Armstrong <don@donarmstrong.com>.
11 use Getopt::Long qw(:config no_ignore_case);
16 debbugs-loadsql -- load debbugs sql database
20 debbugs-loadsql [options]
23 --quick, -q only load changed bugs
24 --service, -s service name
25 --sysconfdir, -c postgresql service config dir
26 --spool-dir debbugs spool directory
27 --debug, -d debugging level (Default 0)
28 --help, -h display this help
29 --man, -m display manual
37 Only load changed bugs
41 Postgreql service to use; defaults to debbugs
43 =item B<--sysconfdir,-c>
45 System configuration directory to use; if not set, defaults to the
46 postgresql default. [Operates by setting PGSYSCONFDIR]
50 Debbugs spool directory; defaults to the value configured in the
51 debbugs configuration file.
59 Display brief useage information.
73 use Debbugs::Common qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list);
74 use Debbugs::Config qw(:config);
75 use Debbugs::Status qw(read_bug split_status_fields);
82 my %options = (debug => 0,
96 'spool_dir|spool-dir=s',
97 'debug|d+','help|h|?','man|m');
99 pod2usage() if $options{help};
100 pod2usage({verbose=>2}) if $options{man};
102 $DEBUG = $options{debug};
105 $options{verbose} = $options{verbose} - $options{quiet};
107 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
109 if (exists $options{sysconfdir}) {
110 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
111 delete $ENV{PGSYSCONFDIR};
113 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
117 if (exists $options{spool_dir} and defined $options{spool_dir}) {
118 $config{spool_dir} = $options{spool_dir};
120 chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
122 my $verbose = $options{debug};
124 my $initialdir = "db-h";
126 if (defined $ARGV[0] and $ARGV[0] eq "archive") {
127 $initialdir = "archive";
130 if (not lockpid($config{spool_dir}.'/lock/debbugs-loadsql')) {
131 if ($options{quick}) {
132 # If this is a quick run, just exit
133 print STDERR "Another debbugs-loadsql is running; stopping\n" if $verbose;
136 print STDERR "Another debbugs-loadsql is running; stopping\n";
140 # connect to the database; figure out how to handle errors properly
142 my $schema = Debbugs::DB->connect('dbi:Pg:service='.$options{service}) or
143 die "Unable to connect to database: ";
146 my $start_time = time;
149 my @dirs = ($initialdir);
153 while (my $dir = shift @dirs) {
154 printf "Doing dir %s ...\n", $dir if $verbose;
156 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
157 my @subdirs = readdir(DIR);
160 my @list = map { m/^(\d+)\.summary$/?($1):() } @subdirs;
161 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
163 for my $bug (@list) {
164 print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
165 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
166 if (not defined $stat) {
167 print STDERR "Unable to stat $bug $!\n";
170 next if $stat->mtime < $time;
171 my $data = read_bug(bug => $bug,
172 location => $initialdir);
173 load_bug($schema,split_status_fields($data),\%tags,\%queue);
176 handle_queue($schema,\%queue);
179 my ($s,$data,$tags,$queue) = @_;
180 my $s_data = split_status_fields($data);
182 for my $tag (make_list($s_data->{keywords})) {
183 next unless defined $tag and length $tag;
184 # this allows for invalid tags. But we'll use this to try to
185 # find those bugs and clean them up
186 if (not exists $tags->{$tag}) {
187 $tags->{$tag} = $s->resultset('Tag')->find_or_create({tag => $tag});
189 push @tags, $tags->{$tag};
191 my $bug = {id => $data->{bug_num},
192 creation => DateTime->from_epoch(epoch => $data->{date}),
193 log_modified => DateTime->from_epoch(epoch => $data->{log_modified}),
194 last_modified => DateTime->from_epoch(epoch => $data->{last_modified}),
195 archived => $data->{archived},
196 (defined $data->{unarchived} and length($data->{unarchived}))?(unarchived => DateTime->from_epoch(epoch => $data->{unarchived})):(),
197 forwarded => $data->{forwarded} // '',
198 summary => $data->{summary} // '',
199 outlook => $data->{outlook} // '',
200 subject => $data->{subject} // '',
201 done => $data->{done} // '',
202 owner => $data->{owner} // '',
203 severity => length($data->{severity}) ? $data->{severity} : $config{default_severity},
205 $s->resultset('Bug')->update_or_create($bug);
207 for my $ff (qw(found fixed)) {
208 my @elements = $s->resultset('BugVer')->search({bug_id => $data->{bug_num},
209 found => $ff eq 'found'?1:0,
211 my %elements_to_delete = map {($elements[$_]->ver_string(),$_)} 0..$#elements;
213 for my $version (@{$data->{"${ff}_versions"}}) {
214 if (exists $elements_to_delete{$version}) {
215 delete $elements_to_delete{$version};
217 push @elements_to_add,$version;
220 for my $element (keys %elements_to_delete) {
221 $elements_to_delete{$element}->delete();
223 for my $element (@elements_to_add) {
224 # find source package and source version id
225 my $ne = $s->resultset('BugVer')->new_result({bug_id => $data->{bug_num},
226 ver_string => $element,
227 found => $ff eq 'found'?1:0,
230 if (my ($src_pkg,$src_ver) = $element =~ m{^([^\/]+)/(.+)$}) {
231 my $src_pkg_e = $s->resultset('SrcPkg')->single({pkg => $src_pkg});
232 if (defined $src_pkg_e) {
233 $ne->src_pkg_id($src_pkg_e->id());
234 my $src_ver_e = $s->resultset('SrcVer')->single({src_pkg_id => $src_pkg_e->id(),
237 $ne->src_ver_id($src_ver_e->id()) if defined $src_ver_e;
245 $s->resultset('BugTag')->search({bug_id => $data->{bug_num}})->delete();
246 $s->populate(BugTag => [[qw(bug_id tag_id)], map {[$data->{bug_num}, $_->id()]} @tags]);
248 # because these bugs reference other bugs which might not exist
249 # yet, we can't handle them until we've loaded all bugs. queue
251 $queue->{merged}{$data->{bug_num}} = [@{$data->{mergedwith}}];
252 $queue->{blocks}{$data->{bug_num}} = [@{$data->{blocks}}];
254 print STDERR "Handled $data->{bug_num}\n";
255 # still need to handle merges, versions, etc.
261 (merged => {set => 'BugMerged',
262 columns => [qw(bug_id merged)],
265 blocks => {set => 'BugBlock',
266 columns => [qw(bug_id blocks)],
270 for my $queue_type (keys %queue_types) {
271 for my $bug (%{$queue->{$queue_type}}) {
272 my $qt = $queue_types{$queue_type};
274 $s->resultset($qt->{set})->search({$qt->{bug_id},$bug})->delete();
275 $s->populate($qt->{set},[[@{$qt->{columns}}],map {[$bug,$_]} @{$queue->{$queue_type}{$bug}}]) if
276 @{$queue->{$queue_type}{$bug}};