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 --quick, -q only load changed things
24 --progress Show progress bar
25 --service, -s service name
26 --sysconfdir, -c postgresql service config dir
27 --spool-dir debbugs spool directory
28 --debug, -d debugging level (Default 0)
29 --help, -h display this help
30 --man, -m display manual
40 Add bugs (subject, number, etc) to the database
42 --preload create all bugs first, then add information
46 Add version descendant information (which version is based on which version) to
51 Add source maintainers to the BTS
55 Add debbugs configuration information (tags, severity, etc)
59 Add suite information from ftp distribution
61 --ftpdists location of FTP mirror
69 Add package information from the ftp archive
71 --ftpdists location of FTP mirror
72 --suites Suite to operate on
76 Add package information from a debinfo file
78 --null -0 names of debinfo files are null separated
86 Only load changed bugs
90 Show progress bar (requires Term::ProgressBar)
94 Postgreql service to use; defaults to debbugs
96 =item B<--sysconfdir,-c>
98 System configuration directory to use; if not set, defaults to the
99 postgresql default. [Operates by setting PGSYSCONFDIR]
103 Debbugs spool directory; defaults to the value configured in the
104 debbugs configuration file.
108 Output more information about what is happening. Probably not useful
109 if you also set --progress.
117 Display brief useage information.
131 use Debbugs::Common (qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list getsourcemaintainers),
133 use Debbugs::Config qw(:config);
134 use Debbugs::Status qw(read_bug split_status_fields);
137 use Debbugs::DB::Load qw(:load_bug :load_package :load_suite);
144 use IO::Uncompress::AnyUncompress;
145 use Encode qw(decode_utf8);
154 service => $config{debbugs_db},
158 Getopt::Long::Configure('pass_through');
159 GetOptions(\%options,
164 'spool_dir|spool-dir=s',
167 'debug|d+','help|h|?','man|m');
168 Getopt::Long::Configure('default');
170 pod2usage() if $options{help};
171 pod2usage({verbose=>2}) if $options{man};
173 $DEBUG = $options{debug};
176 ('bugs' => {function => \&add_bugs,
177 arguments => {'preload' => 0},
179 'versions' => {function => \&add_versions,
181 'debinfo' => {function => \&add_debinfo,
182 arguments => {'0|null' => 0},
184 'maintainers' => {function => \&add_maintainers,
186 'configuration' => {function => \&add_configuration,
188 'suites' => {function => \&add_suite,
189 arguments => {'ftpdists=s' => 1,
192 'logs' => {function => \&add_logs,
194 'packages' => {function => \&add_packages,
195 arguments => {'ftpdists=s' => 1,
199 'help' => {function => sub {pod2usage({verbose => 2});}}
203 $options{verbose} = $options{verbose} - $options{quiet};
205 if ($options{progress}) {
206 eval "use Term::ProgressBar";
207 push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@;
211 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
213 if (exists $options{sysconfdir}) {
214 if (not defined $options{sysconfdir} or not length $options{sysconfdir}) {
215 delete $ENV{PGSYSCONFDIR};
217 $ENV{PGSYSCONFDIR} = $options{sysconfdir};
221 if (exists $options{spool_dir} and defined $options{spool_dir}) {
222 $config{spool_dir} = $options{spool_dir};
226 if ($options{progress}) {
227 $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})";
228 warn "Unable to initialize progress bar: $@" if not $prog_bar;
232 my ($subcommand) = shift @ARGV;
233 if (not defined $subcommand) {
234 $subcommand = 'help';
235 print STDERR "You must provide a subcommand; displaying usage.\n";
237 } elsif (not exists $subcommands{$subcommand}) {
238 print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
242 binmode(STDOUT,':encoding(UTF-8)');
243 binmode(STDERR,':encoding(UTF-8)');
246 handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
247 $subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV);
250 my ($options,$opts,$p,$config,$argv) = @_;
251 chdir($config->{spool_dir}) or
252 die "chdir $config->{spool_dir} failed: $!";
254 my $verbose = $options->{debug};
256 my $initialdir = "db-h";
258 if (defined $argv->[0] and $argv->[0] eq "archive") {
259 $initialdir = "archive";
261 my $s = db_connect($options);
265 my $start_time = time;
270 if ($opts->{preload}) {
272 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
279 $s->resultset('Bug')->quick_insert_bugs(@bugs);
281 walk_bugs([(@{$argv}?@{$argv} : $initialdir)],
287 my $stat = stat(getbugcomponent($bug,'summary',$initialdir));
288 if (not defined $stat) {
289 print STDERR "Unable to stat $bug $!\n";
292 if ($options{quick}) {
293 my $rs = $s->resultset('Bug')->search({bug=>$bug})->single();
294 next if defined $rs and $stat->mtime < $rs->last_modified()->epoch();
296 my $data = read_bug(bug => $bug,
297 location => $initialdir);
300 data => split_status_fields($data),
302 severities => \%severities,
307 print STDERR Dumper($data) if $DEBUG;
308 die "failure while trying to load bug $bug\n$@";
312 handle_load_bug_queue(db => $s,
317 my ($options,$opts,$p,$config,$argv) = @_;
319 my $s = db_connect($options);
321 my @files = @{$argv};
322 $p->target(scalar @files) if $p;
323 for my $file (@files) {
324 my $fh = IO::File->new($file,'r') or
325 die "Unable to open $file for reading: $!";
330 next unless length $_;
331 if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) {
332 push @versions, [$1,$2];
337 for my $i (reverse 0..($#versions)) {
339 if (not defined $src_pkgs{$versions[$i][0]}) {
340 $src_pkgs{$versions[$i][0]} =
341 $s->resultset('SrcPkg')->find_or_create({pkg => $versions[$i][0]});
343 $sp = $src_pkgs{$versions[$i][0]};
344 # There's probably something wrong if the source package
345 # doesn't exist, but we'll skip it for now
346 next unless defined $sp;
347 my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp->id(),
348 ver => $versions[$i][1],
350 if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) {
351 $sv->update({based_on => $ancestor_sv->id()})
361 my ($options,$opts,$p,$config,$argv) = @_;
363 my @files = @{$argv};
374 return unless @files;
375 my $s = db_connect($options);
377 $p->target(scalar @files) if $p;
378 for my $file (@files) {
379 my $fh = IO::File->new($file,'r') or
380 die "Unable to open $file for reading: $!";
381 my $f_stat = stat($file);
384 next unless length $_;
385 my ($binname, $binver, $binarch, $srcname, $srcver) = split;
386 # if $srcver is not defined, this is probably a broken
387 # .debinfo file [they were causing #686106, see commit
388 # 49c85ab8 in dak.] Basically, $binarch didn't get put into
389 # the file, so we'll fudge it from the filename.
390 if (not defined $srcver) {
391 ($srcname,$srcver) = ($binarch,$srcname);
392 ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
394 my $sp = $s->resultset('SrcPkg')->find_or_create({pkg => $srcname});
395 # update the creation date if the data we have is earlier
396 my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime);
397 if ($ct_date < $sp->creation) {
398 $sp->creation($ct_date);
399 $sp->last_modified(DateTime->now);
402 my $sv = $s->resultset('SrcVer')->find_or_create({src_pkg =>$sp->id(),
404 if (not defined $sv->upload_date() or $ct_date < $sv->upload_date()) {
405 $sv->upload_date($ct_date);
409 if (defined $arch{$binarch}) {
410 $arch = $arch{$binarch};
412 $arch = $s->resultset('Arch')->find_or_create({arch => $binarch});
413 $arch{$binarch} = $arch;
415 my $bp = $s->resultset('BinPkg')->find_or_create({pkg => $binname});
416 $s->resultset('BinVer')->find_or_create({bin_pkg => $bp->id(),
417 src_ver => $sv->id(),
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')->search({bug=>$bug})->single();
559 next if defined $rs and $stat->mtime < $rs->last_modified()->epoch();
562 load_bug_log(db => $s,
566 die "failure while trying to load bug log $bug\n$@";
572 my ($options,$opts,$p,$config,$argv) = @_;
574 my $dist_dir = IO::Dir->new($opts->{ftpdists});
576 grep { $_ !~ /^\./ and
577 -d $opts->{ftpdists}.'/'.$_ and
578 not -l $opts->{ftpdists}.'/'.$_
581 while (my $dist = shift @dist_names) {
582 my $dist_dir = $opts->{ftpdists}.'/'.$dist;
583 my ($dist_info,$package_files) =
584 read_release_file($dist_dir.'/Release');
585 $s_p{$dist_info->{Codename}} = $package_files;
588 for my $suite (keys %s_p) {
589 for my $component (keys %{$s_p{$suite}}) {
590 $tot += scalar keys %{$s_p{$suite}{$component}};
593 $p->target($tot) if $p;
596 my $tot_suites = scalar keys %s_p;
598 my $completed_pkgs=0;
599 # parse packages files
600 for my $suite (keys %s_p) {
602 for my $component (keys %{$s_p{$suite}}) {
603 my @archs = keys %{$s_p{$suite}{$component}};
604 if (grep {$_ eq 'source'} @archs) {
605 @archs = ('source',grep {$_ ne 'source'} @archs);
607 for my $arch (@archs) {
608 my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or
609 die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!";
611 local $/ = ''; # paragraph mode
614 for my $field (qw(Package Maintainer Version Source)) {
615 /^\Q$field\E: (.*)/m;
618 next unless defined $pkg{Package} and
619 defined $pkg{Version};
620 push @pkgs,[$arch,$component,\%pkg];
624 my $s = db_connect($options);
628 $p->target($avg_pkgs*($tot_suites-$done_suites-1)+
629 $completed_pkgs+@pkgs) if $p;
634 $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1);
635 $completed_pkgs += @pkgs;
641 sub handle_subcommand_arguments {
642 my ($argv,$args) = @_;
644 Getopt::Long::GetOptionsFromArray($argv,
649 for my $arg (keys %{$args}) {
650 next unless $args->{$arg};
651 my $r_arg = $arg; # real argument name
652 $r_arg =~ s/[=\|].+//g;
653 if (not defined $subopt->{$r_arg}) {
654 push @usage_errors, "You must give a $r_arg option";
657 pod2usage(join("\n",@usage_errors)) if @usage_errors;
662 my ($subcommand,$config,$options) = @_;
663 if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) {
664 if ($options->{quick}) {
665 # If this is a quick run, just exit
666 print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose};
669 print STDERR "Another debbugs-loadsql is running; stopping\n";
676 # connect to the database; figure out how to handle errors
678 my $s = Debbugs::DB->connect($options->{service}) or
679 die "Unable to connect to database: ";
682 sub open_compressed_file {
685 my $mode = '<:encoding(UTF-8)';
687 if ($file =~ /\.gz$/) {
688 $mode = '-|:encoding(UTF-8)';
689 push @opts,'gzip','-dc';
691 if ($file =~ /\.xz$/) {
692 $mode = '-|:encoding(UTF-8)';
693 push @opts,'xz','-dc';
695 if ($file =~ /\.bz2$/) {
696 $mode = '-|:encoding(UTF-8)';
697 push @opts,'bzip2','-dc';
699 open($fh,$mode,@opts,$file);
703 sub read_release_file {
706 my $rfh = open_compressed_file($file) or
707 die "Unable to open $file for reading: $!";
713 if (s/^(\S+):\s*//) {
714 if ($1 eq 'SHA1'or $1 eq 'SHA256') {
721 my ($sha,$size,$f) = split /\s+/,$_;
722 next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/;
723 next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$};
724 my ($component,$arch,$package_source) = ($1,$2,$3);
725 $arch =~ s/binary-//;
726 next if exists $p_f{$component}{$arch};
727 $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f);
730 return (\%dist_info,\%p_f);
734 my ($dirs,$p,$what,$verbose,$sub) = @_;
736 my $tot_dirs = @dirs;
738 my $avg_subfiles = 0;
739 my $completed_files = 0;
740 while (my $dir = shift @dirs) {
741 printf "Doing dir %s ...\n", $dir if $verbose;
743 opendir(DIR, "$dir/.") or die "opendir $dir: $!";
744 my @subdirs = readdir(DIR);
747 my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs;
749 push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs;
751 if ($avg_subfiles == 0) {
752 $avg_subfiles = @list;
755 $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p;
756 $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1);
759 for my $bug (@list) {
761 $p->update($completed_files) if $p;
762 print "Up to $completed_files bugs...\n" if ($completed_files % 100 == 0 && $verbose);