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 'bugs_and_logs' => {function => \&add_bugs_and_logs,
200 'packages' => {function => \&add_packages,
201 arguments => {'ftpdists=s' => 1,
205 'help' => {function => sub {pod2usage({verbose => 2});}}
209 $options{verbose} = $options{verbose} - $options{quiet};
211 if ($options{progress}) {
212 eval "use Term::ProgressBar";
213 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
217 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
219 if (exists $options{sysconfdir}) {
220 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
221 delete $ENV{PGSYSCONFDIR};
223 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
227 if (exists $options{spool_dir} and defined $options{spool_dir}) {
228 $config{spool_dir} = $options{spool_dir};
232 if ($options{progress}) {
233 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
234 warn "Unable to initialize progress bar: $@" if not $prog_bar;
238 my ($subcommand) = shift @ARGV;
239 if (not defined $subcommand) {
240 $subcommand = 'help';
241 print STDERR "You must provide a subcommand; displaying usage.\n";
243 } elsif (not exists $subcommands{$subcommand}) {
244 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
248 binmode(STDOUT,':encoding(UTF-8)');
249 binmode(STDERR,':encoding(UTF-8)');
252 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
253 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
256 my ($options,$opts,$p,$config,$argv) = @_;
257 chdir($config->{spool_dir}) or
258 die "chdir $config->{spool_dir} failed: $!";
260 my $verbose = $options->{debug};
262 my $initialdir = "db-h";
264 if (defined $argv->[0] and $argv->[0] eq "archive") {
265 $initialdir = "archive";
267 my $s = db_connect($options);
271 my $start_time = time;
276 if ($opts->{preload}) {
278 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
287 $s->resultset('Bug')->quick_insert_bugs(@bugs);
289 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
296 if ($options{quick}) {
298 bugs_to_update($s,$initialdir,@bugs);
300 @bugs_to_update = @bugs;
304 for my $bug (@bugs_to_update) {
308 severities => \%severities,
314 die "failure while trying to load bug: $@";
319 handle_load_bug_queue(db => $s,
324 my ($options,$opts,$p,$config,$argv) = @_;
326 my $s = db_connect($options);
328 my @files = @{$argv};
329 $p->target(scalar @files) if $p;
330 for my $file (@files) {
331 my $fh = IO::File->new($file,'r') or
332 die "Unable to open $file for reading: $!";
337 next unless length $_;
338 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
339 push @versions, [$1,$2];
344 for my $i (reverse 0..($#versions)) {
346 if (not defined $src_pkgs{$versions[$i][0]}) {
347 $src_pkgs{$versions[$i][0]} =
348 $s->resultset('SrcPkg')->
349 get_src_pkg_id($versions[$i][0]);
351 $sp = $src_pkgs{$versions[$i][0]};
352 # There's probably something wrong if the source package
353 # doesn't exist, but we'll skip it for now
354 last if not defined $sp;
355 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp,
356 ver => $versions[$i][1],
358 last if not defined $sv;
359 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
360 $sv->update({based_on => $ancestor_sv})
362 $ancestor_sv = $sv->id();
370 my ($options,$opts,$p,$config,$argv) = @_;
372 my @files = @{$argv};
376 local $/ = "\0" if $opts->{0};
378 s/\n$// unless $opts->{0};
379 s/\0$// if $opts->{0};
384 return unless @files;
385 my $s = db_connect($options);
386 $p->target(scalar @files) if $p;
387 my $it = natatime 100, @files;
388 while (my @v = $it->()) {
392 my $fh = IO::File->new($file,'r') or
393 die "Unable to open $file for reading: $!";
394 my $f_stat = stat($file);
395 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
398 next unless length $_;
399 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
400 # if $srcver is not defined, this is probably a broken
401 # .debinfo file [they were causing #686106, see commit
402 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
403 # the file, so we'll fudge it from the filename.
404 if (not defined $srcver) {
405 ($srcname,$srcver) = ($binarch,$srcname);
406 ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
408 if (not defined $srcver) {
409 print STDERR "malformed debinfo (no srcver): $file\n";
413 [$binname,$binver,$binarch,$srcname,$srcver,$ct_date];
418 for my $di (@debinfos) {
419 Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache);
422 $p->update($p->last_update()+@v) if $p;
427 sub add_maintainers {
428 my ($options,$opts,$p,$config,$argv) = @_;
430 my $s = db_connect($options);
431 my $maintainers = getsourcemaintainers();
433 ## get all of the maintainers, and add the missing ones
434 my $maints = $s->resultset('Maintainer')->
435 get_maintainers(values %{$maintainers});
437 my @svs = $s->resultset('SrcVer')->
438 search({maintainer => undef
441 group_by => 'me.src_pkg, src_pkg.pkg',
442 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
443 columns => [qw(me.src_pkg src_pkg.pkg)],
446 $p->target(2+@svs) if $p;
449 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
450 my $pkg = $sv->{src_pkg}{pkg};
451 my $maint = $maints->
452 {$maintainers->{$pkg}};
453 $s->txn_do(sub {$s->resultset('SrcVer')->
454 search({maintainer => undef,
455 'src_pkg.pkg' => $pkg
458 )->update({maintainer => $maint})
466 sub add_configuration {
467 my ($options,$opts,$p,$config,$argv) = @_;
469 my $s = db_connect($options);
474 for my $tag (@{$config{tags}}) {
476 $s->resultset('Tag')->find_or_create({tag => $tag});
479 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
480 next if exists $tags{$tag->tag};
488 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
489 # add all severitites
490 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
491 # mark strong severities
492 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
495 $sev->ordering($order);
498 $sev_names{$sev_name} = 1;
500 # mark obsolete severities
501 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
502 next if exists $sev_names{$sev->severity()};
509 my ($options,$opts,$p,$config,$argv) = @_;
512 my $s = db_connect($options);
513 my $dist_dir = IO::Dir->new($opts->{ftpdists});
515 grep { $_ !~ /^\./ and
516 -d $opts->{ftpdists}.'/'.$_ and
517 not -l $opts->{ftpdists}.'/'.$_
519 while (my $dist = shift @dist_names) {
520 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
521 my ($dist_info,$package_files) =
522 read_release_file($dist_dir.'/Release');
523 load_suite($s,$dist_info);
528 my ($options,$opts,$p,$config,$argv) = @_;
530 chdir($config->{spool_dir}) or
531 die "chdir $config->{spool_dir} failed: $!";
533 my $verbose = $options->{debug};
535 my $initialdir = "db-h";
537 if (defined $argv->[0] and $argv->[0] eq "archive") {
538 $initialdir = "archive";
540 my $s = db_connect($options);
544 my $start_time = time;
546 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
552 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
553 if (not defined $stat) {
554 print STDERR "Unable to stat $bug $!\n";
557 if ($options{quick}) {
558 my $rs = $s->resultset('Bug')->
559 search({id=>$bug})->single();
560 return if defined $rs and
561 $stat->mtime <= $rs->last_modified()->epoch();
564 load_bug_log(db => $s,
568 die "failure while trying to load bug log $bug\n$@";
573 sub add_bugs_and_logs {
574 my ($options,$opts,$p,$config,$argv) = @_;
576 chdir($config->{spool_dir}) or
577 die "chdir $config->{spool_dir} failed: $!";
579 my $verbose = $options->{debug};
581 my $initialdir = "db-h";
583 if (defined $argv->[0] and $argv->[0] eq "archive") {
584 $initialdir = "archive";
586 my $s = db_connect($options);
592 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
599 if ($options{quick}) {
601 bugs_to_update($s,$initialdir,@bugs);
603 @bugs_to_update = @bugs;
607 for my $bug (@bugs_to_update) {
611 severities => \%severities,
617 die "failure while trying to load bug: $@";
619 for my $bug (@bugs) {
620 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
621 if (not defined $stat) {
622 print STDERR "Unable to stat $bug $!\n";
625 if ($options{quick}) {
626 my $rs = $s->resultset('Bug')->
627 search({id=>$bug})->single();
628 return if defined $rs and
629 $stat->mtime <= $rs->last_modified()->epoch();
632 load_bug_log(db => $s,
636 die "failure while trying to load bug log $bug\n$@";
642 handle_load_bug_queue(db=>$s,
649 my ($options,$opts,$p,$config,$argv) = @_;
651 my $dist_dir = IO::Dir->new($opts->{ftpdists});
653 grep { $_ !~ /^\./ and
654 -d $opts->{ftpdists}.'/'.$_ and
655 not -l $opts->{ftpdists}.'/'.$_
658 while (my $dist = shift @dist_names) {
659 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
660 my ($dist_info,$package_files) =
661 read_release_file($dist_dir.'/Release');
662 $s_p{$dist_info->{Codename}} = $package_files;
665 for my $suite (keys %s_p) {
666 for my $component (keys %{$s_p{$suite}}) {
667 $tot += scalar keys %{$s_p{$suite}{$component}};
670 $p->target($tot) if $p;
673 my $tot_suites = scalar keys %s_p;
675 my $completed_pkgs=0;
676 # parse packages files
677 for my $suite (keys %s_p) {
679 for my $component (keys %{$s_p{$suite}}) {
680 my @archs = keys %{$s_p{$suite}{$component}};
681 if (grep {$_ eq 'source'} @archs) {
682 @archs = ('source',grep {$_ ne 'source'} @archs);
684 for my $arch (@archs) {
685 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
686 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
688 local $/ = ''; # paragraph mode
691 for my $field (qw(Package Maintainer Version Source)) {
692 /^\Q$field\E: (.*)/m;
695 next unless defined $pkg{Package} and
696 defined $pkg{Version};
697 push @pkgs,[$arch,$component,\%pkg];
701 my $s = db_connect($options);
705 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
706 $completed_pkgs+@pkgs) if $p;
711 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
712 $completed_pkgs += @pkgs;
718 sub handle_subcommand_arguments {
719 my ($argv,$args) = @_;
721 Getopt::Long::GetOptionsFromArray($argv,
726 for my $arg (keys %{$args}) {
727 next unless $args->{$arg};
728 my $r_arg = $arg; # real argument name
729 $r_arg =~ s/[=\|].+//g;
730 if (not defined $subopt->{$r_arg}) {
731 push @usage_errors, "You must give a $r_arg option";
734 pod2usage(join("\n",@usage_errors)) if @usage_errors;
739 my ($subcommand,$config,$options) = @_;
740 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
741 if ($options->{quick}) {
742 # If this is a quick run, just exit
743 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
746 print STDERR "Another debbugs-loadsql is running; stopping\n";
753 # connect to the database; figure out how to handle errors
755 my $s = Debbugs::DB->connect($options->{service}) or
756 die "Unable to connect to database: ";
759 sub read_release_file {
762 my $rfh = open_compressed_file($file) or
763 die "Unable to open $file for reading: $!";
769 if (s/^(\S+):\s*//) {
770 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
777 my ($sha,$size,$f) = split /\s+/,$_;
778 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
779 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
780 my ($component,$arch,$package_source) = ($1,$2,$3);
781 $arch =~ s/binary-//;
782 next if exists $p_f{$component}{$arch};
783 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
786 return (\%dist_info,\%p_f);
790 my ($dirs,$p,$what,$verbose,$sub,$n) = @_;
792 my $tot_dirs = @dirs;
794 my $avg_subfiles = 0;
795 my $completed_files = 0;
797 while (my $dir = shift @dirs) {
798 printf "Doing dir %s ...\n", $dir if $verbose;
800 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
801 my @subdirs = readdir(DIR);
804 my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
806 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
808 if ($avg_subfiles == 0) {
809 $avg_subfiles = @list;
812 $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
813 $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
816 my $it = natatime $n,@list;
817 while (my @bugs = $it->()) {
819 $completed_files += scalar @bugs;
820 $p->update($completed_files) if $p;
821 print "Up to $completed_files bugs...\n"
822 if ($completed_files % 100 == 0 && $verbose);
830 my ($s,$initialdir,@bugs) = @_;
832 for my $bug (@bugs) {
833 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
834 if (not defined $stat) {
835 print STDERR "Unable to stat $bug $!\n";
838 my $rs = $s->resultset('Bug')->search({id=>$bug})->single();
839 next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch();
840 push @bugs_to_update, $bug;