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),
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);
157 service => $config{debbugs_db},
161 Getopt::Long::Configure('pass_through');
162 GetOptions(\%options,
167 'spool_dir|spool-dir=s',
170 'debug|d+','help|h|?','man|m');
171 Getopt::Long::Configure('default');
173 pod2usage() if $options{help};
174 pod2usage({verbose=>2}) if $options{man};
176 $DEBUG = $options{debug};
179 ('bugs' => {function => \&add_bugs,
180 arguments => {'preload' => 0},
182 'versions' => {function => \&add_versions,
184 'debinfo' => {function => \&add_debinfo,
185 arguments => {'0|null' => 0},
187 'maintainers' => {function => \&add_maintainers,
189 'configuration' => {function => \&add_configuration,
191 'suites' => {function => \&add_suite,
192 arguments => {'ftpdists=s' => 1,
195 'logs' => {function => \&add_logs,
197 'packages' => {function => \&add_packages,
198 arguments => {'ftpdists=s' => 1,
202 'help' => {function => sub {pod2usage({verbose => 2});}}
206 $options{verbose} = $options{verbose} - $options{quiet};
208 if ($options{progress}) {
209 eval "use Term::ProgressBar";
210 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
214 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
216 if (exists $options{sysconfdir}) {
217 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
218 delete $ENV{PGSYSCONFDIR};
220 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
224 if (exists $options{spool_dir} and defined $options{spool_dir}) {
225 $config{spool_dir} = $options{spool_dir};
229 if ($options{progress}) {
230 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
231 warn "Unable to initialize progress bar: $@" if not $prog_bar;
235 my ($subcommand) = shift @ARGV;
236 if (not defined $subcommand) {
237 $subcommand = 'help';
238 print STDERR "You must provide a subcommand; displaying usage.\n";
240 } elsif (not exists $subcommands{$subcommand}) {
241 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
245 binmode(STDOUT,':encoding(UTF-8)');
246 binmode(STDERR,':encoding(UTF-8)');
249 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
250 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
253 my ($options,$opts,$p,$config,$argv) = @_;
254 chdir($config->{spool_dir}) or
255 die "chdir $config->{spool_dir} failed: $!";
257 my $verbose = $options->{debug};
259 my $initialdir = "db-h";
261 if (defined $argv->[0] and $argv->[0] eq "archive") {
262 $initialdir = "archive";
264 my $s = db_connect($options);
268 my $start_time = time;
273 if ($opts->{preload}) {
275 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
282 $s->resultset('Bug')->quick_insert_bugs(@bugs);
284 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
290 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
291 if (not defined $stat) {
292 print STDERR "Unable to stat $bug $!\n";
295 if ($options{quick}) {
296 my $rs = $s->resultset('Bug')->search({bug=>$bug})->single();
297 next if defined $rs and $stat->mtime < $rs->last_modified()->epoch();
299 my $data = read_bug(bug => $bug,
300 location => $initialdir);
303 data => split_status_fields($data),
305 severities => \%severities,
310 print STDERR Dumper($data) if $DEBUG;
311 die "failure while trying to load bug $bug\n$@";
315 handle_load_bug_queue(db => $s,
320 my ($options,$opts,$p,$config,$argv) = @_;
322 my $s = db_connect($options);
324 my @files = @{$argv};
325 $p->target(scalar @files) if $p;
326 for my $file (@files) {
327 my $fh = IO::File->new($file,'r') or
328 die "Unable to open $file for reading: $!";
333 next unless length $_;
334 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
335 push @versions, [$1,$2];
340 for my $i (reverse 0..($#versions)) {
342 if (not defined $src_pkgs{$versions[$i][0]}) {
343 $src_pkgs{$versions[$i][0]} =
344 $s->resultset('SrcPkg')->find_or_create({pkg => $versions[$i][0]});
346 $sp = $src_pkgs{$versions[$i][0]};
347 # There's probably something wrong if the source package
348 # doesn't exist, but we'll skip it for now
349 next unless defined $sp;
350 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp->id(),
351 ver => $versions[$i][1],
353 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
354 $sv->update({based_on => $ancestor_sv->id()})
364 my ($options,$opts,$p,$config,$argv) = @_;
366 my @files = @{$argv};
377 return unless @files;
378 my $s = db_connect($options);
380 $p->target(scalar @files) if $p;
381 for my $file (@files) {
382 my $fh = IO::File->new($file,'r') or
383 die "Unable to open $file for reading: $!";
384 my $f_stat = stat($file);
387 next unless length $_;
388 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
389 # if $srcver is not defined, this is probably a broken
390 # .debinfo file [they were causing #686106, see commit
391 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
392 # the file, so we'll fudge it from the filename.
393 if (not defined $srcver) {
394 ($srcname,$srcver) = ($binarch,$srcname);
395 ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
397 my $sp = $s->resultset('SrcPkg')->find_or_create({pkg => $srcname});
398 # update the creation date if the data we have is earlier
399 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
400 if ($ct_date < $sp->creation) {
401 $sp->creation($ct_date);
402 $sp->last_modified(DateTime->now);
405 my $sv = $s->resultset('SrcVer')->find_or_create({src_pkg =>$sp->id(),
407 if (not defined $sv->upload_date() or $ct_date < $sv->upload_date()) {
408 $sv->upload_date($ct_date);
412 if (defined $arch{$binarch}) {
413 $arch = $arch{$binarch};
415 $arch = $s->resultset('Arch')->find_or_create({arch => $binarch});
416 $arch{$binarch} = $arch;
418 my $bp = $s->resultset('BinPkg')->find_or_create({pkg => $binname});
419 $s->resultset('BinVer')->find_or_create({bin_pkg => $bp->id(),
420 src_ver => $sv->id(),
430 sub add_maintainers {
431 my ($options,$opts,$p,$config,$argv) = @_;
433 my $s = db_connect($options);
434 my $maintainers = getsourcemaintainers();
436 ## get all of the maintainers, and add the missing ones
437 my $maints = $s->resultset('Maintainer')->
438 get_maintainers(values %{$maintainers});
440 my @svs = $s->resultset('SrcVer')->
441 search({maintainer => undef
444 group_by => 'me.src_pkg, src_pkg.pkg',
445 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
446 columns => [qw(me.src_pkg src_pkg.pkg)],
449 $p->target(2+@svs) if $p;
452 if (exists $maintainers->{$sv->{src_pkg}{pkg}}) {
453 my $pkg = $sv->{src_pkg}{pkg};
454 my $maint = $maints->
455 {$maintainers->{$pkg}};
456 $s->txn_do(sub {$s->resultset('SrcVer')->
457 search({maintainer => undef,
458 'src_pkg.pkg' => $pkg
461 )->update({maintainer => $maint})
469 sub add_configuration {
470 my ($options,$opts,$p,$config,$argv) = @_;
472 my $s = db_connect($options);
477 for my $tag (@{$config{tags}}) {
479 $s->resultset('Tag')->find_or_create({tag => $tag});
482 for my $tag ($s->resultset('Tag')->search_rs()->all()) {
483 next if exists $tags{$tag->tag};
491 for my $sev_name (($config{default_severity},@{$config{severity_list}})) {
492 # add all severitites
493 my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name});
494 # mark strong severities
495 if (grep {$_ eq $sev_name} @{$config{strong_severities}}) {
498 $sev->ordering($order);
501 $sev_names{$sev_name} = 1;
503 # mark obsolete severities
504 for my $sev ($s->resultset('Severity')->search_rs()->all()) {
505 next if exists $sev_names{$sev->severity()};
512 my ($options,$opts,$p,$config,$argv) = @_;
515 my $s = db_connect($options);
516 my $dist_dir = IO::Dir->new($opts->{ftpdists});
518 grep { $_ !~ /^\./ and
519 -d $opts->{ftpdists}.'/'.$_ and
520 not -l $opts->{ftpdists}.'/'.$_
522 while (my $dist = shift @dist_names) {
523 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
524 my ($dist_info,$package_files) =
525 read_release_file($dist_dir.'/Release');
526 load_suite($s,$dist_info);
531 my ($options,$opts,$p,$config,$argv) = @_;
533 chdir($config->{spool_dir}) or
534 die "chdir $config->{spool_dir} failed: $!";
536 my $verbose = $options->{debug};
538 my $initialdir = "db-h";
540 if (defined $argv->[0] and $argv->[0] eq "archive") {
541 $initialdir = "archive";
543 my $s = db_connect($options);
547 my $start_time = time;
549 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
555 my $stat = stat(getbugcomponent($bug,'log',$initialdir));
556 if (not defined $stat) {
557 print STDERR "Unable to stat $bug $!\n";
560 if ($options{quick}) {
561 my $rs = $s->resultset('Bug')->search({bug=>$bug})->single();
562 next if defined $rs and $stat->mtime < $rs->last_modified()->epoch();
565 load_bug_log(db => $s,
569 die "failure while trying to load bug log $bug\n$@";
575 my ($options,$opts,$p,$config,$argv) = @_;
577 my $dist_dir = IO::Dir->new($opts->{ftpdists});
579 grep { $_ !~ /^\./ and
580 -d $opts->{ftpdists}.'/'.$_ and
581 not -l $opts->{ftpdists}.'/'.$_
584 while (my $dist = shift @dist_names) {
585 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
586 my ($dist_info,$package_files) =
587 read_release_file($dist_dir.'/Release');
588 $s_p{$dist_info->{Codename}} = $package_files;
591 for my $suite (keys %s_p) {
592 for my $component (keys %{$s_p{$suite}}) {
593 $tot += scalar keys %{$s_p{$suite}{$component}};
596 $p->target($tot) if $p;
599 my $tot_suites = scalar keys %s_p;
601 my $completed_pkgs=0;
602 # parse packages files
603 for my $suite (keys %s_p) {
605 for my $component (keys %{$s_p{$suite}}) {
606 my @archs = keys %{$s_p{$suite}{$component}};
607 if (grep {$_ eq 'source'} @archs) {
608 @archs = ('source',grep {$_ ne 'source'} @archs);
610 for my $arch (@archs) {
611 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
612 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
614 local $/ = ''; # paragraph mode
617 for my $field (qw(Package Maintainer Version Source)) {
618 /^\Q$field\E: (.*)/m;
621 next unless defined $pkg{Package} and
622 defined $pkg{Version};
623 push @pkgs,[$arch,$component,\%pkg];
627 my $s = db_connect($options);
631 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
632 $completed_pkgs+@pkgs) if $p;
637 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
638 $completed_pkgs += @pkgs;
644 sub handle_subcommand_arguments {
645 my ($argv,$args) = @_;
647 Getopt::Long::GetOptionsFromArray($argv,
652 for my $arg (keys %{$args}) {
653 next unless $args->{$arg};
654 my $r_arg = $arg; # real argument name
655 $r_arg =~ s/[=\|].+//g;
656 if (not defined $subopt->{$r_arg}) {
657 push @usage_errors, "You must give a $r_arg option";
660 pod2usage(join("\n",@usage_errors)) if @usage_errors;
665 my ($subcommand,$config,$options) = @_;
666 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
667 if ($options->{quick}) {
668 # If this is a quick run, just exit
669 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
672 print STDERR "Another debbugs-loadsql is running; stopping\n";
679 # connect to the database; figure out how to handle errors
681 my $s = Debbugs::DB->connect($options->{service}) or
682 die "Unable to connect to database: ";
685 sub open_compressed_file {
688 my $mode = '<:encoding(UTF-8)';
690 if ($file =~ /\.gz$/) {
691 $mode = '-|:encoding(UTF-8)';
692 push @opts,'gzip','-dc';
694 if ($file =~ /\.xz$/) {
695 $mode = '-|:encoding(UTF-8)';
696 push @opts,'xz','-dc';
698 if ($file =~ /\.bz2$/) {
699 $mode = '-|:encoding(UTF-8)';
700 push @opts,'bzip2','-dc';
702 open($fh,$mode,@opts,$file);
706 sub read_release_file {
709 my $rfh = open_compressed_file($file) or
710 die "Unable to open $file for reading: $!";
716 if (s/^(\S+):\s*//) {
717 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
724 my ($sha,$size,$f) = split /\s+/,$_;
725 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
726 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
727 my ($component,$arch,$package_source) = ($1,$2,$3);
728 $arch =~ s/binary-//;
729 next if exists $p_f{$component}{$arch};
730 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
733 return (\%dist_info,\%p_f);
737 my ($dirs,$p,$what,$verbose,$sub) = @_;
739 my $tot_dirs = @dirs;
741 my $avg_subfiles = 0;
742 my $completed_files = 0;
743 while (my $dir = shift @dirs) {
744 printf "Doing dir %s ...\n", $dir if $verbose;
746 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
747 my @subdirs = readdir(DIR);
750 my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
752 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
754 if ($avg_subfiles == 0) {
755 $avg_subfiles = @list;
758 $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
759 $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
762 for my $bug (@list) {
764 $p->update($completed_files) if $p;
765 print "Up to $completed_files bugs...\n" if ($completed_files % 100 == 0 && $verbose);