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 --progress Show progress bar
25 --service, -s service name
26 --sysconfdir, -c postgresql service config dir
27 --spool-dir debbugs spool directory
28 --debug, -d debugging level (Default 0)
29 --help, -h display this help
30 --man, -m display manual
38 Only load changed bugs
42 Show progress bar (requires Term::ProgressBar)
46 Postgreql service to use; defaults to debbugs
48 =item B<--sysconfdir,-c>
50 System configuration directory to use; if not set, defaults to the
51 postgresql default. [Operates by setting PGSYSCONFDIR]
55 Debbugs spool directory; defaults to the value configured in the
56 debbugs configuration file.
60 Output more information about what is happening. Probably not useful
61 if you also set --progress.
69 Display brief useage information.
83 use Debbugs::Common qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list getsourcemaintainers);
84 use Debbugs::Config qw(:config);
85 use Debbugs::Status qw(read_bug split_status_fields);
88 use Debbugs::DB::Load qw(load_bug handle_load_bug_queue);
100 service => 'debbugs',
104 my $gop = Getopt::Long::Parser->new();
105 $gop->configure('pass_through');
106 $gop->getoptions(\%options,
111 'spool_dir|spool-dir=s',
114 'debug|d+','help|h|?','man|m');
115 $gop->getoptions('default');
117 pod2usage() if $options{help};
118 pod2usage({verbose=>2}) if $options{man};
120 $DEBUG = $options{debug};
123 ('bugs' => {function => \&add_bugs,
125 'versions' => {function => \&add_versions,
127 'debinfo' => {function => \&add_debinfo,
129 'maintainers' => {function => \&add_maintainers,
131 'configuration' => {function => \&add_configuration,
133 'logs' => {function => \&add_logs,
138 $options{verbose} = $options{verbose} - $options{quiet};
140 if ($options{progress}) {
141 eval "use Term::ProgressBar";
142 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
146 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
148 if (exists $options{sysconfdir}) {
149 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
150 delete $ENV{PGSYSCONFDIR};
152 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
156 if (exists $options{spool_dir} and defined $options{spool_dir}) {
157 $config{spool_dir} = $options{spool_dir};
161 if ($options{progress}) {
162 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
163 warn "Unable to initialize progress bar: $@" if not $prog_bar;
167 my ($subcommand) = shift @ARGV;
170 handle_arguments(\@ARGV,$subcommands{$subcommand}{arguments},$gop);
171 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
174 my ($options,$opts,$p,$config,$argv) = @_;
175 chdir($config->{spool_dir}) or
176 die "chdir $config->{spool_dir} failed: $!";
178 my $verbose = $options->{debug};
180 my $initialdir = "db-h";
182 if (defined $argv->[0] and $argv->[0] eq "archive") {
183 $initialdir = "archive";
185 my $s = db_connect($options);
189 my $start_time = time;
192 my @dirs = (@{$argv}?@{$argv} : $initialdir);
197 my $tot_dirs = @{$argv}? @{$argv} : 0;
199 my $avg_subfiles = 0;
200 my $completed_files = 0;
201 while (my $dir = shift @dirs) {
202 printf "Doing dir %s ...\n", $dir if $verbose;
204 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
205 my @subdirs = readdir(DIR);
208 my @list = map { m/^(\d+)\.summary$/?($1):() } @subdirs;
210 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
212 if ($avg_subfiles == 0) {
213 $avg_subfiles = @list;
216 $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
217 $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
220 for my $bug (@list) {
222 $p->update($completed_files) if $p;
223 print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose);
224 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
225 if (not defined $stat) {
226 print STDERR "Unable to stat $bug $!\n";
229 next if $stat->mtime < $time;
230 my $data = read_bug(bug => $bug,
231 location => $initialdir);
234 data => split_status_fields($data),
236 severities => \%severities,
241 print STDERR Dumper($data) if $DEBUG;
242 die "failure while trying to load bug $bug\n$@";
247 handle_load_bug_queue(db => $s,
252 my ($options,$opts,$p,$config,$argv) = @_;
254 my $s = db_connect($options);
256 my @files = @{$argv};
257 $p->target(@files) if $p;
258 for my $file (@files) {
259 my $fh = IO::File->new($file,'r') or
260 die "Unable to open $file for reading: $!";
265 next unless length $_;
266 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
267 push @versions, [$1,$2];
272 for my $i (reverse 0..($#versions)) {
274 if (not defined $src_pkgs{$versions[$i][0]}) {
275 $src_pkgs{$versions[$i][0]} =
276 $s->resultset('SrcPkg')->find({pkg => $versions[$i][0]});
278 $sp = $src_pkgs{$versions[$i][0]};
279 # There's probably something wrong if the source package
280 # doesn't exist, but we'll skip it for now
281 next unless defined $sp;
282 my $sv = $s->resultset('SrcVer')->find({src_pkg_id=>$sp->id(),
283 ver => $versions[$i][1],
285 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
286 $sv->update({based_on => $ancestor_sv->id()})
296 my ($options,$opts,$p,$config,$argv) = @_;
298 my @files = @{$argv};
299 my $s = db_connect($options);
302 $p->target(@files) if $p;
303 for my $file (@files) {
304 my $fh = IO::File->new($file,'r') or
305 die "Unable to open $file for reading: $!";
306 my $f_stat = stat($file);
309 next unless length $_;
310 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
311 # if $srcver is not defined, this is probably a broken
312 # .debinfo file [they were causing #686106, see commit
313 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
314 # the file, so we'll fudge it from the filename.
315 if (not defined $srcver) {
316 ($srcname,$srcver) = ($binarch,$srcname);
317 ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
319 my $sp = $s->resultset('SrcPkg')->find_or_create({pkg => $srcname});
320 my $sv = $s->resultset('SrcVer')->find_or_create({src_pkg_id=>$sp->id(),
323 if (defined $arch{$binarch}) {
324 $arch = $arch{$binarch};
326 $arch = $s->resultset('Arch')->find_or_create({arch => $binarch});
327 $arch{$binarch} = $arch;
329 my $bp = $s->resultset('BinPkg')->find_or_create({pkg => $binname});
330 $s->resultset('BinVer')->find_or_create({bin_pkg_id => $bp->id(),
331 src_ver_id => $sv->id(),
332 arch_id => $arch->id(),
341 sub add_maintainers {
342 my ($options,$opts,$p,$config,$argv) = @_;
344 my $s = db_connect($options);
345 my $maintainers = getsourcemaintainers();
346 $p->target(scalar keys %{$maintainers}) if $p;
347 for my $pkg (keys %{$maintainers}) {
348 my $maint = $maintainers->{$pkg};
349 # see if a maintainer already exists; if so, we don't do
351 my $maint_r = $s->resultset('Maintainer')->
352 find({name => $maint});
353 if (not defined $maint_r) {
354 # get e-mail address of maintainer
355 my $e_mail = getparsedaddrs($maint);
357 my $correspondent = $s->resultset('Correspondent')->
358 find_or_create({addr => $e_mail});
360 $s->resultset('Maintainer')->
361 find_or_create({name => $maint,
362 correspondent => $correspondent,
365 # add the maintainer to the source package for packages with
368 $s->resultset('SrcPkg')->
369 search_related_rs('SrcVer',{ maintainer_id => undef})->
370 update_all({maintainer_id => $maint_r});
377 sub add_configuration {
378 my ($options,$opts,$p,$config,$argv) = @_;
382 my ($options,$opts,$p,$config,$argv) = @_;
385 sub handle_subcommand_arguments {
386 my ($argv,$args,$gop) = @_;
388 $gop->getoptionsfromarray($argv,
393 for my $arg (keys %{$args}) {
394 next unless $args->{$arg};
395 my $r_arg = $arg; # real argument name
396 $r_arg =~ s/[=\|].+//g;
397 if (not defined $subopt->{$r_arg}) {
398 push @usage_errors, "You must give a $r_arg option";
401 pod2usage(join("\n",@usage_errors)) if @usage_errors;
406 my ($subcommand,$config,$options) = @_;
407 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
408 if ($options->{quick}) {
409 # If this is a quick run, just exit
410 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
413 print STDERR "Another debbugs-loadsql is running; stopping\n";
420 # connect to the database; figure out how to handle errors
422 my $s = Debbugs::DB->connect('dbi:Pg:service='.$options->{service}) or
423 die "Unable to connect to database: ";