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] [subcommand]
23 bugs help versions configuration
24 suites logs packages debinfo
26 --quick, -q only load changed things
27 --progress Show progress bar
28 --service, -s service name
29 --sysconfdir, -c postgresql service config dir
30 --spool-dir debbugs spool directory
31 --debug, -d debugging level (Default 0)
32 --help, -h display this help
33 --man, -m display manual
43 Add bugs (subject, number, etc) to the database
45 --preload create all bugs first, then add information
49 Add version descendant information (which version is based on which version) to
54 Add source maintainers to the BTS
58 Add debbugs configuration information (tags, severity, etc)
62 Add suite information from ftp distribution
64 --ftpdists location of FTP mirror
72 Add package information from the ftp archive
74 --ftpdists location of FTP mirror
75 --suites Suite to operate on
79 Add package information from a debinfo file
81 --null -0 names of debinfo files are null separated
89 Only load changed bugs
93 Show progress bar (requires Term::ProgressBar)
97 Postgreql service to use; defaults to debbugs
99 =item B<--sysconfdir,-c>
101 System configuration directory to use; if not set, defaults to the
102 postgresql default. [Operates by setting PGSYSCONFDIR]
106 Debbugs spool directory; defaults to the value configured in the
107 debbugs configuration file.
111 Output more information about what is happening. Probably not useful
112 if you also set --progress.
120 Display brief useage information.
134 use Debbugs::Common (qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list getsourcemaintainers),
135 qw(hash_slice open_compressed_file),);
136 use Debbugs::Config qw(:config);
137 use Debbugs::Status qw(read_bug split_status_fields);
140 use Debbugs::DB::Load qw(:load_bug :load_package :load_suite);
147 use IO::Uncompress::AnyUncompress;
148 use Encode qw(decode_utf8);
149 use List::MoreUtils qw(natatime);
158 service => $config{debbugs_db},
162 Getopt::Long::Configure('pass_through');
163 GetOptions(\%options,
168 'spool_dir|spool-dir=s',
171 'debug|d+','help|h|?','man|m');
172 Getopt::Long::Configure('default');
174 pod2usage() if $options{help};
175 pod2usage({verbose=>2}) if $options{man};
177 $DEBUG = $options{debug};
180 ('bugs' => {function => \&add_bugs,
181 arguments => {'preload' => 0},
183 'versions' => {function => \&add_versions,
185 'debinfo' => {function => \&add_debinfo,
186 arguments => {'0|null' => 0},
188 'maintainers' => {function => \&add_maintainers,
190 'configuration' => {function => \&add_configuration,
192 'suites' => {function => \&add_suite,
193 arguments => {'ftpdists=s' => 1,
196 'logs' => {function => \&add_logs,
198 'packages' => {function => \&add_packages,
199 arguments => {'ftpdists=s' => 1,
203 'help' => {function => sub {pod2usage({verbose => 2});}}
207 $options{verbose} = $options{verbose} - $options{quiet};
209 if ($options{progress}) {
210 eval "use Term::ProgressBar";
211 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
215 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
217 if (exists $options{sysconfdir}) {
218 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
219 delete $ENV{PGSYSCONFDIR};
221 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
225 if (exists $options{spool_dir} and defined $options{spool_dir}) {
226 $config{spool_dir} = $options{spool_dir};
230 if ($options{progress}) {
231 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
232 warn "Unable to initialize progress bar: $@" if not $prog_bar;
236 my ($subcommand) = shift @ARGV;
237 if (not defined $subcommand) {
238 $subcommand = 'help';
239 print STDERR "You must provide a subcommand; displaying usage.\n";
241 } elsif (not exists $subcommands{$subcommand}) {
242 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
246 binmode(STDOUT,':encoding(UTF-8)');
247 binmode(STDERR,':encoding(UTF-8)');
250 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
251 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
254 my ($options,$opts,$p,$config,$argv) = @_;
255 chdir($config->{spool_dir}) or
256 die "chdir $config->{spool_dir} failed: $!";
258 my $verbose = $options->{debug};
260 my $initialdir = "db-h";
262 if (defined $argv->[0] and $argv->[0] eq "archive") {
263 $initialdir = "archive";
265 my $s = db_connect($options);
269 my $start_time = time;
274 if ($opts->{preload}) {
276 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
285 $s->resultset('Bug')->quick_insert_bugs(@bugs);
287 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
294 if ($options{quick}) {
295 for my $bug (@bugs) {
296 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
297 if (not defined $stat) {
298 print STDERR "Unable to stat $bug $!\n";
301 my $rs = $s->resultset('Bug')->search({id=>$bug})->single();
302 next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch();
303 push @bugs_to_update, $bug;
306 @bugs_to_update = @bugs;
310 for my $bug (@bugs_to_update) {
314 severities => \%severities,
320 die "failure while trying to load bug: $@";
325 handle_load_bug_queue(db => $s,
330 my ($options,$opts,$p,$config,$argv) = @_;
332 my $s = db_connect($options);
334 my @files = @{$argv};
335 $p->target(scalar @files) if $p;
336 for my $file (@files) {
337 my $fh = IO::File->new($file,'r') or
338 die "Unable to open $file for reading: $!";
343 next unless length $_;
344 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
345 push @versions, [$1,$2];
350 for my $i (reverse 0..($#versions)) {
352 if (not defined $src_pkgs{$versions[$i][0]}) {
353 $src_pkgs{$versions[$i][0]} =
354 $s->resultset('SrcPkg')->
355 get_src_pkg_id($versions[$i][0]);
357 $sp = $src_pkgs{$versions[$i][0]};
358 # There's probably something wrong if the source package
359 # doesn't exist, but we'll skip it for now
360 last if not defined $sp;
361 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp,
362 ver => $versions[$i][1],
364 last if not defined $sv;
365 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
366 $sv->update({based_on => $ancestor_sv})
368 $ancestor_sv = $sv->id();
376 my ($options,$opts,$p,$config,$argv) = @_;
378 my @files = @{$argv};
382 local $/ = "\0" if $opts->{0};
384 s/\n$// unless $opts->{0};
385 s/\0$// if $opts->{0};
390 return unless @files;
391 my $s = db_connect($options);
392 $p->target(scalar @files) if $p;
393 my $it = natatime 100, @files;
394 while (my @v = $it->()) {
398 my $fh = IO::File->new($file,'r') or
399 die "Unable to open $file for reading: $!";
400 my $f_stat = stat($file);
401 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
404 next unless length $_;
405 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
406 # if $srcver is not defined, this is probably a broken
407 # .debinfo file [they were causing #686106, see commit
408 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
409 # the file, so we'll fudge it from the filename.
410 if (not defined $srcver) {
411 ($srcname,$srcver) = ($binarch,$srcname);
412 ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
414 if (not defined $srcver) {
415 print STDERR "malformed debinfo (no srcver): $file\n";
419 [$binname,$binver,$binarch,$srcname,$srcver,$ct_date];
424 for my $di (@debinfos) {
425 Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache);
428 $p->update($p->last_update()+@v) if $p;
433 sub add_maintainers {
434 my ($options,$opts,$p,$config,$argv) = @_;
436 my $s = db_connect($options);
437 my $maintainers = getsourcemaintainers();
439 ## get all of the maintainers, and add the missing ones
440 my $maints = $s->resultset('Maintainer')->
441 get_maintainers(values %{$maintainers});
443 my @svs = $s->resultset('SrcVer')->
444 search({maintainer => undef
447 group_by => 'me.src_pkg, src_pkg.pkg',
448 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
449 columns => [qw(me.src_pkg src_pkg.pkg)],
452 $p->target(2+@svs) if $p;
455 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
456 my $pkg = $sv->{src_pkg}{pkg};
457 my $maint = $maints->
458 {$maintainers->{$pkg}};
459 $s->txn_do(sub {$s->resultset('SrcVer')->
460 search({maintainer => undef,
461 'src_pkg.pkg' => $pkg
464 )->update({maintainer => $maint})
472 sub add_configuration {
473 my ($options,$opts,$p,$config,$argv) = @_;
475 my $s = db_connect($options);
480 for my $tag (@{$config{tags}}) {
482 $s->resultset('Tag')->find_or_create({tag => $tag});
485 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
486 next if exists $tags{$tag->tag};
494 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
495 # add all severitites
496 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
497 # mark strong severities
498 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
501 $sev->ordering($order);
504 $sev_names{$sev_name} = 1;
506 # mark obsolete severities
507 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
508 next if exists $sev_names{$sev->severity()};
515 my ($options,$opts,$p,$config,$argv) = @_;
518 my $s = db_connect($options);
519 my $dist_dir = IO::Dir->new($opts->{ftpdists});
521 grep { $_ !~ /^\./ and
522 -d $opts->{ftpdists}.'/'.$_ and
523 not -l $opts->{ftpdists}.'/'.$_
525 while (my $dist = shift @dist_names) {
526 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
527 my ($dist_info,$package_files) =
528 read_release_file($dist_dir.'/Release');
529 load_suite($s,$dist_info);
534 my ($options,$opts,$p,$config,$argv) = @_;
536 chdir($config->{spool_dir}) or
537 die "chdir $config->{spool_dir} failed: $!";
539 my $verbose = $options->{debug};
541 my $initialdir = "db-h";
543 if (defined $argv->[0] and $argv->[0] eq "archive") {
544 $initialdir = "archive";
546 my $s = db_connect($options);
550 my $start_time = time;
552 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
558 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
559 if (not defined $stat) {
560 print STDERR "Unable to stat $bug $!\n";
563 if ($options{quick}) {
564 my $rs = $s->resultset('Bug')->
565 search({id=>$bug})->single();
566 next if defined $rs and
567 $stat->mtime <= $rs->last_modified()->epoch();
570 load_bug_log(db => $s,
574 die "failure while trying to load bug log $bug\n$@";
580 my ($options,$opts,$p,$config,$argv) = @_;
582 my $dist_dir = IO::Dir->new($opts->{ftpdists});
584 grep { $_ !~ /^\./ and
585 -d $opts->{ftpdists}.'/'.$_ and
586 not -l $opts->{ftpdists}.'/'.$_
589 while (my $dist = shift @dist_names) {
590 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
591 my ($dist_info,$package_files) =
592 read_release_file($dist_dir.'/Release');
593 $s_p{$dist_info->{Codename}} = $package_files;
596 for my $suite (keys %s_p) {
597 for my $component (keys %{$s_p{$suite}}) {
598 $tot += scalar keys %{$s_p{$suite}{$component}};
601 $p->target($tot) if $p;
604 my $tot_suites = scalar keys %s_p;
606 my $completed_pkgs=0;
607 # parse packages files
608 for my $suite (keys %s_p) {
610 for my $component (keys %{$s_p{$suite}}) {
611 my @archs = keys %{$s_p{$suite}{$component}};
612 if (grep {$_ eq 'source'} @archs) {
613 @archs = ('source',grep {$_ ne 'source'} @archs);
615 for my $arch (@archs) {
616 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
617 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
619 local $/ = ''; # paragraph mode
622 for my $field (qw(Package Maintainer Version Source)) {
623 /^\Q$field\E: (.*)/m;
626 next unless defined $pkg{Package} and
627 defined $pkg{Version};
628 push @pkgs,[$arch,$component,\%pkg];
632 my $s = db_connect($options);
636 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
637 $completed_pkgs+@pkgs) if $p;
642 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
643 $completed_pkgs += @pkgs;
649 sub handle_subcommand_arguments {
650 my ($argv,$args) = @_;
652 Getopt::Long::GetOptionsFromArray($argv,
657 for my $arg (keys %{$args}) {
658 next unless $args->{$arg};
659 my $r_arg = $arg; # real argument name
660 $r_arg =~ s/[=\|].+//g;
661 if (not defined $subopt->{$r_arg}) {
662 push @usage_errors, "You must give a $r_arg option";
665 pod2usage(join("\n",@usage_errors)) if @usage_errors;
670 my ($subcommand,$config,$options) = @_;
671 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
672 if ($options->{quick}) {
673 # If this is a quick run, just exit
674 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
677 print STDERR "Another debbugs-loadsql is running; stopping\n";
684 # connect to the database; figure out how to handle errors
686 my $s = Debbugs::DB->connect($options->{service}) or
687 die "Unable to connect to database: ";
690 sub read_release_file {
693 my $rfh = open_compressed_file($file) or
694 die "Unable to open $file for reading: $!";
700 if (s/^(\S+):\s*//) {
701 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
708 my ($sha,$size,$f) = split /\s+/,$_;
709 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
710 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
711 my ($component,$arch,$package_source) = ($1,$2,$3);
712 $arch =~ s/binary-//;
713 next if exists $p_f{$component}{$arch};
714 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
717 return (\%dist_info,\%p_f);
721 my ($dirs,$p,$what,$verbose,$sub,$n) = @_;
723 my $tot_dirs = @dirs;
725 my $avg_subfiles = 0;
726 my $completed_files = 0;
728 while (my $dir = shift @dirs) {
729 printf "Doing dir %s ...\n", $dir if $verbose;
731 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
732 my @subdirs = readdir(DIR);
735 my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
737 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
739 if ($avg_subfiles == 0) {
740 $avg_subfiles = @list;
743 $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
744 $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
747 my $it = natatime $n,@list;
748 while (my @bugs = $it->()) {
750 $completed_files += scalar @bugs;
751 $p->update($completed_files) if $p;
752 print "Up to $completed_files bugs...\n"
753 if ($completed_files % 100 == 0 && $verbose);