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);
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}) {
296 bugs_to_update($s,$initialdir,@bugs);
298 @bugs_to_update = @bugs;
302 for my $bug (@bugs_to_update) {
306 severities => \%severities,
312 die "failure while trying to load bug: $@";
317 handle_load_bug_queue(db => $s,
322 my ($options,$opts,$p,$config,$argv) = @_;
324 my $s = db_connect($options);
326 my @files = @{$argv};
327 $p->target(scalar @files) if $p;
328 for my $file (@files) {
329 my $fh = IO::File->new($file,'r') or
330 die "Unable to open $file for reading: $!";
335 next unless length $_;
336 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
337 push @versions, [$1,$2];
342 for my $i (reverse 0..($#versions)) {
344 if (not defined $src_pkgs{$versions[$i][0]}) {
345 $src_pkgs{$versions[$i][0]} =
346 $s->resultset('SrcPkg')->
347 get_src_pkg_id($versions[$i][0]);
349 $sp = $src_pkgs{$versions[$i][0]};
350 # There's probably something wrong if the source package
351 # doesn't exist, but we'll skip it for now
352 last if not defined $sp;
353 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp,
354 ver => $versions[$i][1],
356 last if not defined $sv;
357 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
358 $sv->update({based_on => $ancestor_sv})
360 $ancestor_sv = $sv->id();
368 my ($options,$opts,$p,$config,$argv) = @_;
370 my @files = @{$argv};
374 local $/ = "\0" if $opts->{0};
376 s/\n$// unless $opts->{0};
377 s/\0$// if $opts->{0};
382 return unless @files;
383 my $s = db_connect($options);
384 $p->target(scalar @files) if $p;
385 my $it = natatime 100, @files;
386 while (my @v = $it->()) {
390 my $fh = IO::File->new($file,'r') or
391 die "Unable to open $file for reading: $!";
392 my $f_stat = stat($file);
393 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
396 next unless length $_;
397 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
398 # if $srcver is not defined, this is probably a broken
399 # .debinfo file [they were causing #686106, see commit
400 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
401 # the file, so we'll fudge it from the filename.
402 if (not defined $srcver) {
403 ($srcname,$srcver) = ($binarch,$srcname);
404 ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
406 if (not defined $srcver) {
407 print STDERR "malformed debinfo (no srcver): $file\n";
411 [$binname,$binver,$binarch,$srcname,$srcver,$ct_date];
416 for my $di (@debinfos) {
417 Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache);
420 $p->update($p->last_update()+@v) if $p;
425 sub add_maintainers {
426 my ($options,$opts,$p,$config,$argv) = @_;
428 my $s = db_connect($options);
429 my $maintainers = getsourcemaintainers();
431 ## get all of the maintainers, and add the missing ones
432 my $maints = $s->resultset('Maintainer')->
433 get_maintainers(values %{$maintainers});
435 my @svs = $s->resultset('SrcVer')->
436 search({maintainer => undef
439 group_by => 'me.src_pkg, src_pkg.pkg',
440 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
441 columns => [qw(me.src_pkg src_pkg.pkg)],
444 $p->target(2+@svs) if $p;
447 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
448 my $pkg = $sv->{src_pkg}{pkg};
449 my $maint = $maints->
450 {$maintainers->{$pkg}};
451 $s->txn_do(sub {$s->resultset('SrcVer')->
452 search({maintainer => undef,
453 'src_pkg.pkg' => $pkg
456 )->update({maintainer => $maint})
464 sub add_configuration {
465 my ($options,$opts,$p,$config,$argv) = @_;
467 my $s = db_connect($options);
472 for my $tag (@{$config{tags}}) {
474 $s->resultset('Tag')->find_or_create({tag => $tag});
477 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
478 next if exists $tags{$tag->tag};
486 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
487 # add all severitites
488 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
489 # mark strong severities
490 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
493 $sev->ordering($order);
496 $sev_names{$sev_name} = 1;
498 # mark obsolete severities
499 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
500 next if exists $sev_names{$sev->severity()};
507 my ($options,$opts,$p,$config,$argv) = @_;
510 my $s = db_connect($options);
511 my $dist_dir = IO::Dir->new($opts->{ftpdists});
513 grep { $_ !~ /^\./ and
514 -d $opts->{ftpdists}.'/'.$_ and
515 not -l $opts->{ftpdists}.'/'.$_
517 while (my $dist = shift @dist_names) {
518 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
519 my ($dist_info,$package_files) =
520 read_release_file($dist_dir.'/Release');
521 load_suite($s,$dist_info);
526 my ($options,$opts,$p,$config,$argv) = @_;
528 chdir($config->{spool_dir}) or
529 die "chdir $config->{spool_dir} failed: $!";
531 my $verbose = $options->{debug};
533 my $initialdir = "db-h";
535 if (defined $argv->[0] and $argv->[0] eq "archive") {
536 $initialdir = "archive";
538 my $s = db_connect($options);
540 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
546 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
547 if (not defined $stat) {
548 print STDERR "Unable to stat $bug $!\n";
551 if ($options{quick}) {
552 my $rs = $s->resultset('Bug')->
553 search({id=>$bug})->single();
554 return if defined $rs and
555 $stat->mtime <= $rs->last_modified()->epoch();
558 load_bug_log(db => $s,
562 die "failure while trying to load bug log $bug\n$@";
567 sub add_bugs_and_logs {
568 my ($options,$opts,$p,$config,$argv) = @_;
570 chdir($config->{spool_dir}) or
571 die "chdir $config->{spool_dir} failed: $!";
573 my $verbose = $options->{debug};
575 my $initialdir = "db-h";
577 if (defined $argv->[0] and $argv->[0] eq "archive") {
578 $initialdir = "archive";
580 my $s = db_connect($options);
586 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
593 if ($options{quick}) {
595 bugs_to_update($s,$initialdir,@bugs);
597 @bugs_to_update = @bugs;
601 for my $bug (@bugs_to_update) {
605 severities => \%severities,
611 die "failure while trying to load bug: $@";
613 for my $bug (@bugs) {
614 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
615 if (not defined $stat) {
616 print STDERR "Unable to stat $bug $!\n";
619 if ($options{quick}) {
620 my $rs = $s->resultset('Bug')->
621 search({id=>$bug})->single();
622 return if defined $rs and
623 $stat->mtime <= $rs->last_modified()->epoch();
626 load_bug_log(db => $s,
630 die "failure while trying to load bug log $bug\n$@";
636 handle_load_bug_queue(db=>$s,
643 my ($options,$opts,$p,$config,$argv) = @_;
645 my $dist_dir = IO::Dir->new($opts->{ftpdists});
647 grep { $_ !~ /^\./ and
648 -d $opts->{ftpdists}.'/'.$_ and
649 not -l $opts->{ftpdists}.'/'.$_
652 while (my $dist = shift @dist_names) {
653 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
654 my ($dist_info,$package_files) =
655 read_release_file($dist_dir.'/Release');
656 $s_p{$dist_info->{Codename}} = $package_files;
659 for my $suite (keys %s_p) {
660 for my $component (keys %{$s_p{$suite}}) {
661 $tot += scalar keys %{$s_p{$suite}{$component}};
664 $p->target($tot) if $p;
667 my $tot_suites = scalar keys %s_p;
669 my $completed_pkgs=0;
670 # parse packages files
671 for my $suite (keys %s_p) {
673 for my $component (keys %{$s_p{$suite}}) {
674 my @archs = keys %{$s_p{$suite}{$component}};
675 if (grep {$_ eq 'source'} @archs) {
676 @archs = ('source',grep {$_ ne 'source'} @archs);
678 for my $arch (@archs) {
679 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
680 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
682 local $/ = ''; # paragraph mode
685 for my $field (qw(Package Maintainer Version Source)) {
686 /^\Q$field\E: (.*)/m;
689 next unless defined $pkg{Package} and
690 defined $pkg{Version};
691 push @pkgs,[$arch,$component,\%pkg];
695 my $s = db_connect($options);
699 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
700 $completed_pkgs+@pkgs) if $p;
705 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
706 $completed_pkgs += @pkgs;
712 sub handle_subcommand_arguments {
713 my ($argv,$args) = @_;
715 Getopt::Long::GetOptionsFromArray($argv,
720 for my $arg (keys %{$args}) {
721 next unless $args->{$arg};
722 my $r_arg = $arg; # real argument name
723 $r_arg =~ s/[=\|].+//g;
724 if (not defined $subopt->{$r_arg}) {
725 push @usage_errors, "You must give a $r_arg option";
728 pod2usage(join("\n",@usage_errors)) if @usage_errors;
733 my ($subcommand,$config,$options) = @_;
734 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
735 if ($options->{quick}) {
736 # If this is a quick run, just exit
737 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
740 print STDERR "Another debbugs-loadsql is running; stopping\n";
747 # connect to the database; figure out how to handle errors
749 my $s = Debbugs::DB->connect($options->{service}) or
750 die "Unable to connect to database: ";
753 sub read_release_file {
756 my $rfh = open_compressed_file($file) or
757 die "Unable to open $file for reading: $!";
763 if (s/^(\S+):\s*//) {
764 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
771 my ($sha,$size,$f) = split /\s+/,$_;
772 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
773 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
774 my ($component,$arch,$package_source) = ($1,$2,$3);
775 $arch =~ s/binary-//;
776 next if exists $p_f{$component}{$arch};
777 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
780 return (\%dist_info,\%p_f);
784 my ($dirs,$p,$what,$verbose,$sub,$n) = @_;
786 my $tot_dirs = @dirs;
788 my $avg_subfiles = 0;
789 my $completed_files = 0;
791 while (my $dir = shift @dirs) {
792 printf "Doing dir %s ...\n", $dir if $verbose;
794 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
795 my @subdirs = readdir(DIR);
798 my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
800 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
802 if ($avg_subfiles == 0) {
803 $avg_subfiles = @list;
806 $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
807 $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
810 my $it = natatime $n,@list;
811 while (my @bugs = $it->()) {
813 $completed_files += scalar @bugs;
814 $p->update($completed_files) if $p;
815 print "Up to $completed_files bugs...\n"
816 if ($completed_files % 100 == 0 && $verbose);
824 my ($s,$initialdir,@bugs) = @_;
826 for my $bug (@bugs) {
827 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
828 if (not defined $stat) {
829 print STDERR "Unable to stat $bug $!\n";
832 my $rs = $s->resultset('Bug')->search({id=>$bug})->single();
833 next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch();
834 push @bugs_to_update, $bug;