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,
169 'spool_dir|spool-dir=s',
172 'debug|d+','help|h|?','man|m');
173 Getopt::Long::Configure('default');
175 pod2usage() if $options{help};
176 pod2usage({verbose=>2}) if $options{man};
178 $DEBUG = $options{debug};
181 ('bugs' => {function => \&add_bugs,
182 arguments => {'preload' => 0},
184 'versions' => {function => \&add_versions,
186 'debinfo' => {function => \&add_debinfo,
187 arguments => {'0|null' => 0},
189 'maintainers' => {function => \&add_maintainers,
191 'configuration' => {function => \&add_configuration,
193 'suites' => {function => \&add_suite,
194 arguments => {'ftpdists=s' => 1,
197 'logs' => {function => \&add_logs,
199 'bugs_and_logs' => {function => \&add_bugs_and_logs,
201 'packages' => {function => \&add_packages,
202 arguments => {'ftpdists=s' => 1,
206 'help' => {function => sub {pod2usage({verbose => 2});}}
210 $options{verbose} = $options{verbose} - $options{quiet};
212 if ($options{progress}) {
213 eval "use Term::ProgressBar";
214 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
218 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
220 if (exists $options{sysconfdir}) {
221 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
222 delete $ENV{PGSYSCONFDIR};
224 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
228 if (exists $options{spool_dir} and defined $options{spool_dir}) {
229 $config{spool_dir} = $options{spool_dir};
233 if ($options{progress}) {
234 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
235 warn "Unable to initialize progress bar: $@" if not $prog_bar;
239 my ($subcommand) = shift @ARGV;
240 if (not defined $subcommand) {
241 $subcommand = 'help';
242 print STDERR "You must provide a subcommand; displaying usage.\n";
244 } elsif (not exists $subcommands{$subcommand}) {
245 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
249 binmode(STDOUT,':encoding(UTF-8)');
250 binmode(STDERR,':encoding(UTF-8)');
253 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
254 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
257 my ($options,$opts,$p,$config,$argv) = @_;
258 chdir($config->{spool_dir}) or
259 die "chdir $config->{spool_dir} failed: $!";
261 my $verbose = $options->{debug};
263 my $initialdir = "db-h";
265 if (defined $argv->[0] and $argv->[0] eq "archive") {
266 $initialdir = "archive";
268 my $s = db_connect($options);
275 if ($opts->{preload}) {
277 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
286 $s->resultset('Bug')->quick_insert_bugs(@bugs);
288 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
295 if ($options{quick}) {
297 bugs_to_update($s,$initialdir,@bugs);
299 @bugs_to_update = @bugs;
303 for my $bug (@bugs_to_update) {
307 severities => \%severities,
313 die "failure while trying to load bug: $@";
318 handle_load_bug_queue(db => $s,
323 my ($options,$opts,$p,$config,$argv) = @_;
325 my $s = db_connect($options);
327 my @files = @{$argv};
328 $p->target(scalar @files) if $p;
329 for my $file (@files) {
330 my $fh = IO::File->new($file,'r') or
331 die "Unable to open $file for reading: $!";
336 next unless length $_;
337 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
338 push @versions, [$1,$2];
343 for my $i (reverse 0..($#versions)) {
345 if (not defined $src_pkgs{$versions[$i][0]}) {
346 $src_pkgs{$versions[$i][0]} =
347 $s->resultset('SrcPkg')->
348 get_src_pkg_id($versions[$i][0]);
350 $sp = $src_pkgs{$versions[$i][0]};
351 # There's probably something wrong if the source package
352 # doesn't exist, but we'll skip it for now
353 last if not defined $sp;
354 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp,
355 ver => $versions[$i][1],
357 last if not defined $sv;
358 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
359 $sv->update({based_on => $ancestor_sv})
361 $ancestor_sv = $sv->id();
369 my ($options,$opts,$p,$config,$argv) = @_;
371 my @files = @{$argv};
375 local $/ = "\0" if $opts->{0};
377 s/\n$// unless $opts->{0};
378 s/\0$// if $opts->{0};
383 return unless @files;
384 my $s = db_connect($options);
385 $p->target(scalar @files) if $p;
386 my $it = natatime 100, @files;
387 while (my @v = $it->()) {
391 my $fh = IO::File->new($file,'r') or
392 die "Unable to open $file for reading: $!";
393 my $f_stat = stat($file);
394 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
397 next unless length $_;
398 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
399 # if $srcver is not defined, this is probably a broken
400 # .debinfo file [they were causing #686106, see commit
401 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
402 # the file, so we'll fudge it from the filename.
403 if (not defined $srcver) {
404 ($srcname,$srcver) = ($binarch,$srcname);
405 ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
407 if (not defined $srcver) {
408 print STDERR "malformed debinfo (no srcver): $file\n";
412 [$binname,$binver,$binarch,$srcname,$srcver,$ct_date];
417 for my $di (@debinfos) {
418 Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache);
421 $p->update($p->last_update()+@v) if $p;
426 sub add_maintainers {
427 my ($options,$opts,$p,$config,$argv) = @_;
429 my $s = db_connect($options);
430 my $maintainers = getsourcemaintainers();
432 ## get all of the maintainers, and add the missing ones
433 my $maints = $s->resultset('Maintainer')->
434 get_maintainers(values %{$maintainers});
436 my @svs = $s->resultset('SrcVer')->
437 search({maintainer => undef
440 group_by => 'me.src_pkg, src_pkg.pkg',
441 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
442 columns => [qw(me.src_pkg src_pkg.pkg)],
445 $p->target(2+@svs) if $p;
448 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
449 my $pkg = $sv->{src_pkg}{pkg};
450 my $maint = $maints->
451 {$maintainers->{$pkg}};
452 $s->txn_do(sub {$s->resultset('SrcVer')->
453 search({maintainer => undef,
454 'src_pkg.pkg' => $pkg
457 )->update({maintainer => $maint})
465 sub add_configuration {
466 my ($options,$opts,$p,$config,$argv) = @_;
468 my $s = db_connect($options);
473 for my $tag (@{$config{tags}}) {
475 $s->resultset('Tag')->find_or_create({tag => $tag});
478 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
479 next if exists $tags{$tag->tag};
487 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
488 # add all severitites
489 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
490 # mark strong severities
491 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
494 $sev->ordering($order);
497 $sev_names{$sev_name} = 1;
499 # mark obsolete severities
500 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
501 next if exists $sev_names{$sev->severity()};
508 my ($options,$opts,$p,$config,$argv) = @_;
511 my $s = db_connect($options);
512 my $dist_dir = IO::Dir->new($opts->{ftpdists});
514 grep { $_ !~ /^\./ and
515 -d $opts->{ftpdists}.'/'.$_ and
516 not -l $opts->{ftpdists}.'/'.$_
518 while (my $dist = shift @dist_names) {
519 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
520 my ($dist_info,$package_files) =
521 read_release_file($dist_dir.'/Release');
522 load_suite($s,$dist_info);
527 my ($options,$opts,$p,$config,$argv) = @_;
529 chdir($config->{spool_dir}) or
530 die "chdir $config->{spool_dir} failed: $!";
532 my $verbose = $options->{debug};
534 my $initialdir = "db-h";
536 if (defined $argv->[0] and $argv->[0] eq "archive") {
537 $initialdir = "archive";
539 my $s = db_connect($options);
541 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
547 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
548 if (not defined $stat) {
549 print STDERR "Unable to stat $bug $!\n";
552 if ($options{quick}) {
553 my $rs = $s->resultset('Bug')->
554 search({id=>$bug})->single();
555 return if defined $rs and
556 $stat->mtime <= $rs->last_modified()->epoch();
559 load_bug_log(db => $s,
563 die "failure while trying to load bug log $bug\n$@";
568 sub add_bugs_and_logs {
569 my ($options,$opts,$p,$config,$argv) = @_;
571 chdir($config->{spool_dir}) or
572 die "chdir $config->{spool_dir} failed: $!";
574 my $verbose = $options->{debug};
576 my $initialdir = "db-h";
578 if (defined $argv->[0] and $argv->[0] eq "archive") {
579 $initialdir = "archive";
581 my $s = db_connect($options);
587 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
594 if ($options{quick}) {
596 bugs_to_update($s,$initialdir,@bugs);
598 @bugs_to_update = @bugs;
602 for my $bug (@bugs_to_update) {
606 severities => \%severities,
612 die "failure while trying to load bug: $@";
614 for my $bug (@bugs) {
615 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
616 if (not defined $stat) {
617 print STDERR "Unable to stat $bug $!\n";
620 if ($options{quick}) {
621 my $rs = $s->resultset('Bug')->
622 search({id=>$bug})->single();
623 return if defined $rs and
624 $stat->mtime <= $rs->last_modified()->epoch();
627 load_bug_log(db => $s,
631 die "failure while trying to load bug log $bug\n$@";
637 handle_load_bug_queue(db=>$s,
644 my ($options,$opts,$p,$config,$argv) = @_;
646 my $dist_dir = IO::Dir->new($opts->{ftpdists});
648 grep { $_ !~ /^\./ and
649 -d $opts->{ftpdists}.'/'.$_ and
650 not -l $opts->{ftpdists}.'/'.$_
653 while (my $dist = shift @dist_names) {
654 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
655 my ($dist_info,$package_files) =
656 read_release_file($dist_dir.'/Release');
657 $s_p{$dist_info->{Codename}} = $package_files;
660 for my $suite (keys %s_p) {
661 for my $component (keys %{$s_p{$suite}}) {
662 $tot += scalar keys %{$s_p{$suite}{$component}};
665 $p->target($tot) if $p;
668 my $tot_suites = scalar keys %s_p;
670 my $completed_pkgs=0;
671 # parse packages files
672 for my $suite (keys %s_p) {
674 for my $component (keys %{$s_p{$suite}}) {
675 my @archs = keys %{$s_p{$suite}{$component}};
676 if (grep {$_ eq 'source'} @archs) {
677 @archs = ('source',grep {$_ ne 'source'} @archs);
679 for my $arch (@archs) {
680 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
681 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
683 local $/ = ''; # paragraph mode
686 for my $field (qw(Package Maintainer Version Source)) {
687 /^\Q$field\E: (.*)/m;
690 next unless defined $pkg{Package} and
691 defined $pkg{Version};
692 push @pkgs,[$arch,$component,\%pkg];
696 my $s = db_connect($options);
700 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
701 $completed_pkgs+@pkgs) if $p;
706 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
707 $completed_pkgs += @pkgs;
713 sub handle_subcommand_arguments {
714 my ($argv,$args) = @_;
716 Getopt::Long::GetOptionsFromArray($argv,
721 for my $arg (keys %{$args}) {
722 next unless $args->{$arg};
723 my $r_arg = $arg; # real argument name
724 $r_arg =~ s/[=\|].+//g;
725 if (not defined $subopt->{$r_arg}) {
726 push @usage_errors, "You must give a $r_arg option";
729 pod2usage(join("\n",@usage_errors)) if @usage_errors;
734 my ($subcommand,$config,$options) = @_;
735 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
736 if ($options->{quick}) {
737 # If this is a quick run, just exit
738 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
741 print STDERR "Another debbugs-loadsql is running; stopping\n";
748 # connect to the database; figure out how to handle errors
750 my $s = Debbugs::DB->connect($options->{dsn} //
751 $options->{service}) or
752 die "Unable to connect to database: ";
755 sub read_release_file {
758 my $rfh = open_compressed_file($file) or
759 die "Unable to open $file for reading: $!";
765 if (s/^(\S+):\s*//) {
766 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
773 my ($sha,$size,$f) = split /\s+/,$_;
774 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
775 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
776 my ($component,$arch,$package_source) = ($1,$2,$3);
777 $arch =~ s/binary-//;
778 next if exists $p_f{$component}{$arch};
779 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
782 return (\%dist_info,\%p_f);
786 my ($dirs,$p,$what,$verbose,$sub,$n) = @_;
788 my $tot_dirs = @dirs;
790 my $avg_subfiles = 0;
791 my $completed_files = 0;
793 while (my $dir = shift @dirs) {
794 printf "Doing dir %s ...\n", $dir if $verbose;
796 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
797 my @subdirs = readdir(DIR);
800 my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
802 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
804 if ($avg_subfiles == 0) {
805 $avg_subfiles = @list;
808 $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
809 $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
812 my $it = natatime $n,@list;
813 while (my @bugs = $it->()) {
815 $completed_files += scalar @bugs;
816 $p->update($completed_files) if $p;
817 print "Up to $completed_files bugs...\n"
818 if ($completed_files % 100 == 0 && $verbose);
826 my ($s,$initialdir,@bugs) = @_;
828 for my $bug (@bugs) {
829 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
830 if (not defined $stat) {
831 print STDERR "Unable to stat $bug $!\n";
834 my $rs = $s->resultset('Bug')->search({id=>$bug})->single();
835 next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch();
836 push @bugs_to_update, $bug;