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) {
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')->find_or_create({pkg => $versions[$i][0]});
356 $sp = $src_pkgs{$versions[$i][0]};
357 # There's probably something wrong if the source package
358 # doesn't exist, but we'll skip it for now
359 next unless defined $sp;
360 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp->id(),
361 ver => $versions[$i][1],
363 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
364 $sv->update({based_on => $ancestor_sv->id()})
374 my ($options,$opts,$p,$config,$argv) = @_;
376 my @files = @{$argv};
387 return unless @files;
388 my $s = db_connect($options);
390 $p->target(scalar @files) if $p;
391 for my $file (@files) {
392 my $fh = IO::File->new($file,'r') or
393 die "Unable to open $file for reading: $!";
394 my $f_stat = stat($file);
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 my $sp = $s->resultset('SrcPkg')->find_or_create({pkg => $srcname});
408 # update the creation date if the data we have is earlier
409 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
410 if ($ct_date < $sp->creation) {
411 $sp->creation($ct_date);
412 $sp->last_modified(DateTime->now);
415 my $sv = $s->resultset('SrcVer')->find_or_create({src_pkg =>$sp->id(),
417 if (not defined $sv->upload_date() or $ct_date < $sv->upload_date()) {
418 $sv->upload_date($ct_date);
422 if (defined $arch{$binarch}) {
423 $arch = $arch{$binarch};
425 $arch = $s->resultset('Arch')->find_or_create({arch => $binarch});
426 $arch{$binarch} = $arch;
428 my $bp = $s->resultset('BinPkg')->find_or_create({pkg => $binname});
429 $s->resultset('BinVer')->find_or_create({bin_pkg => $bp->id(),
430 src_ver => $sv->id(),
440 sub add_maintainers {
441 my ($options,$opts,$p,$config,$argv) = @_;
443 my $s = db_connect($options);
444 my $maintainers = getsourcemaintainers();
446 ## get all of the maintainers, and add the missing ones
447 my $maints = $s->resultset('Maintainer')->
448 get_maintainers(values %{$maintainers});
450 my @svs = $s->resultset('SrcVer')->
451 search({maintainer => undef
454 group_by => 'me.src_pkg, src_pkg.pkg',
455 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
456 columns => [qw(me.src_pkg src_pkg.pkg)],
459 $p->target(2+@svs) if $p;
462 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
463 my $pkg = $sv->{src_pkg}{pkg};
464 my $maint = $maints->
465 {$maintainers->{$pkg}};
466 $s->txn_do(sub {$s->resultset('SrcVer')->
467 search({maintainer => undef,
468 'src_pkg.pkg' => $pkg
471 )->update({maintainer => $maint})
479 sub add_configuration {
480 my ($options,$opts,$p,$config,$argv) = @_;
482 my $s = db_connect($options);
487 for my $tag (@{$config{tags}}) {
489 $s->resultset('Tag')->find_or_create({tag => $tag});
492 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
493 next if exists $tags{$tag->tag};
501 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
502 # add all severitites
503 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
504 # mark strong severities
505 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
508 $sev->ordering($order);
511 $sev_names{$sev_name} = 1;
513 # mark obsolete severities
514 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
515 next if exists $sev_names{$sev->severity()};
522 my ($options,$opts,$p,$config,$argv) = @_;
525 my $s = db_connect($options);
526 my $dist_dir = IO::Dir->new($opts->{ftpdists});
528 grep { $_ !~ /^\./ and
529 -d $opts->{ftpdists}.'/'.$_ and
530 not -l $opts->{ftpdists}.'/'.$_
532 while (my $dist = shift @dist_names) {
533 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
534 my ($dist_info,$package_files) =
535 read_release_file($dist_dir.'/Release');
536 load_suite($s,$dist_info);
541 my ($options,$opts,$p,$config,$argv) = @_;
543 chdir($config->{spool_dir}) or
544 die "chdir $config->{spool_dir} failed: $!";
546 my $verbose = $options->{debug};
548 my $initialdir = "db-h";
550 if (defined $argv->[0] and $argv->[0] eq "archive") {
551 $initialdir = "archive";
553 my $s = db_connect($options);
557 my $start_time = time;
559 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
565 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
566 if (not defined $stat) {
567 print STDERR "Unable to stat $bug $!\n";
570 if ($options{quick}) {
571 my $rs = $s->resultset('Bug')->search({bug=>$bug})->single();
572 next if defined $rs and $stat->mtime < $rs->last_modified()->epoch();
575 load_bug_log(db => $s,
579 die "failure while trying to load bug log $bug\n$@";
585 my ($options,$opts,$p,$config,$argv) = @_;
587 my $dist_dir = IO::Dir->new($opts->{ftpdists});
589 grep { $_ !~ /^\./ and
590 -d $opts->{ftpdists}.'/'.$_ and
591 not -l $opts->{ftpdists}.'/'.$_
594 while (my $dist = shift @dist_names) {
595 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
596 my ($dist_info,$package_files) =
597 read_release_file($dist_dir.'/Release');
598 $s_p{$dist_info->{Codename}} = $package_files;
601 for my $suite (keys %s_p) {
602 for my $component (keys %{$s_p{$suite}}) {
603 $tot += scalar keys %{$s_p{$suite}{$component}};
606 $p->target($tot) if $p;
609 my $tot_suites = scalar keys %s_p;
611 my $completed_pkgs=0;
612 # parse packages files
613 for my $suite (keys %s_p) {
615 for my $component (keys %{$s_p{$suite}}) {
616 my @archs = keys %{$s_p{$suite}{$component}};
617 if (grep {$_ eq 'source'} @archs) {
618 @archs = ('source',grep {$_ ne 'source'} @archs);
620 for my $arch (@archs) {
621 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
622 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
624 local $/ = ''; # paragraph mode
627 for my $field (qw(Package Maintainer Version Source)) {
628 /^\Q$field\E: (.*)/m;
631 next unless defined $pkg{Package} and
632 defined $pkg{Version};
633 push @pkgs,[$arch,$component,\%pkg];
637 my $s = db_connect($options);
641 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
642 $completed_pkgs+@pkgs) if $p;
647 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
648 $completed_pkgs += @pkgs;
654 sub handle_subcommand_arguments {
655 my ($argv,$args) = @_;
657 Getopt::Long::GetOptionsFromArray($argv,
662 for my $arg (keys %{$args}) {
663 next unless $args->{$arg};
664 my $r_arg = $arg; # real argument name
665 $r_arg =~ s/[=\|].+//g;
666 if (not defined $subopt->{$r_arg}) {
667 push @usage_errors, "You must give a $r_arg option";
670 pod2usage(join("\n",@usage_errors)) if @usage_errors;
675 my ($subcommand,$config,$options) = @_;
676 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
677 if ($options->{quick}) {
678 # If this is a quick run, just exit
679 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
682 print STDERR "Another debbugs-loadsql is running; stopping\n";
689 # connect to the database; figure out how to handle errors
691 my $s = Debbugs::DB->connect($options->{service}) or
692 die "Unable to connect to database: ";
695 sub read_release_file {
698 my $rfh = open_compressed_file($file) or
699 die "Unable to open $file for reading: $!";
705 if (s/^(\S+):\s*//) {
706 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
713 my ($sha,$size,$f) = split /\s+/,$_;
714 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
715 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
716 my ($component,$arch,$package_source) = ($1,$2,$3);
717 $arch =~ s/binary-//;
718 next if exists $p_f{$component}{$arch};
719 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
722 return (\%dist_info,\%p_f);
726 my ($dirs,$p,$what,$verbose,$sub,$n) = @_;
728 my $tot_dirs = @dirs;
730 my $avg_subfiles = 0;
731 my $completed_files = 0;
733 while (my $dir = shift @dirs) {
734 printf "Doing dir %s ...\n", $dir if $verbose;
736 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
737 my @subdirs = readdir(DIR);
740 my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
742 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
744 if ($avg_subfiles == 0) {
745 $avg_subfiles = @list;
748 $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
749 $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
752 my $it = natatime $n,@list;
753 while (my @bugs = $it->()) {
755 $completed_files += scalar @bugs;
756 $p->update($completed_files) if $p;
757 print "Up to $completed_files bugs...\n"
758 if ($completed_files % 100 == 0 && $verbose);