X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=bin%2Fdebbugs-loadsql;h=f37a8ef6fea4d91963c1072cf0e881827f5d8244;hb=0de3bc6bd4599f57878d7d3306f7edc79c614495;hp=849e27fa316e8826e1458ca5ed16cd5149270598;hpb=6091f73ce65064a2876ba44253a6335e5208f3d9;p=debbugs.git diff --git a/bin/debbugs-loadsql b/bin/debbugs-loadsql index 849e27f..f37a8ef 100755 --- a/bin/debbugs-loadsql +++ b/bin/debbugs-loadsql @@ -17,16 +17,69 @@ debbugs-loadsql -- load debbugs sql database =head1 SYNOPSIS -debbugs-loadsql [options] +debbugs-loadsql [options] [subcommand] + Subcommands: + bugs help versions configuration + suites logs packages debinfo Options: - --quick, -q only load changed bugs + --quick, -q only load changed things + --progress Show progress bar --service, -s service name --sysconfdir, -c postgresql service config dir + --spool-dir debbugs spool directory --debug, -d debugging level (Default 0) --help, -h display this help --man, -m display manual +=head1 SUBCOMMANDS + +=head2 help + +Display this manual + +=head2 bugs + +Add bugs (subject, number, etc) to the database + + --preload create all bugs first, then add information + +=head2 versions + +Add version descendant information (which version is based on which version) to +the database + +=head2 maintainers + +Add source maintainers to the BTS + +=head2 configuration + +Add debbugs configuration information (tags, severity, etc) + +=head2 suites + +Add suite information from ftp distribution + + --ftpdists location of FTP mirror + +=head2 logs + +Add bug logs + +=head2 packages + +Add package information from the ftp archive + + --ftpdists location of FTP mirror + --suites Suite to operate on + +=head2 debinfo + +Add package information from a debinfo file + + --null -0 names of debinfo files are null separated + =head1 OPTIONS =over @@ -35,6 +88,10 @@ debbugs-loadsql [options] Only load changed bugs +=item B<--progress> + +Show progress bar (requires Term::ProgressBar) + =item B<--service,-s> Postgreql service to use; defaults to debbugs @@ -44,7 +101,17 @@ Postgreql service to use; defaults to debbugs System configuration directory to use; if not set, defaults to the postgresql default. [Operates by setting PGSYSCONFDIR] -=item B<--debug, -d +=item B<--spool-dir> + +Debbugs spool directory; defaults to the value configured in the +debbugs configuration file. + +=item B<--verbose> + +Output more information about what is happening. Probably not useful +if you also set --progress. + +=item B<--debug, -d> Debug verbosity. @@ -64,215 +131,636 @@ Display this manual. use vars qw($DEBUG); -use Debbugs::Common qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list); +use Debbugs::Common (qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list getsourcemaintainers), + qw(hash_slice open_compressed_file),); use Debbugs::Config qw(:config); use Debbugs::Status qw(read_bug split_status_fields); use Debbugs::Log; use Debbugs::DB; +use Debbugs::DB::Load qw(:load_bug :load_package :load_suite); use DateTime; use File::stat; - - -my %options = (debug => 0, - help => 0, - man => 0, - verbose => 0, - quiet => 0, - quick => 0, - service => 'debbugs', - ); - - +use File::Basename; +use File::Spec; +use IO::Dir; +use IO::File; +use IO::Uncompress::AnyUncompress; +use Encode qw(decode_utf8); +use List::MoreUtils qw(natatime); + +my %options = + (debug => 0, + help => 0, + man => 0, + verbose => 0, + quiet => 0, + quick => 0, + service => $config{debbugs_db}, + progress => 0, + ); + +Getopt::Long::Configure('pass_through'); GetOptions(\%options, - 'quick|q', - 'service|s', - 'sysconfdir|c', - 'spool_dir|spool-dir=s', - 'debug|d+','help|h|?','man|m'); + 'quick|q', + 'service|s=s', + 'sysconfdir|c=s', + 'progress!', + 'spool_dir|spool-dir=s', + 'verbose|v+', + 'quiet+', + 'debug|d+','help|h|?','man|m'); +Getopt::Long::Configure('default'); pod2usage() if $options{help}; pod2usage({verbose=>2}) if $options{man}; $DEBUG = $options{debug}; +my %subcommands = + ('bugs' => {function => \&add_bugs, + arguments => {'preload' => 0}, + }, + 'versions' => {function => \&add_versions, + }, + 'debinfo' => {function => \&add_debinfo, + arguments => {'0|null' => 0}, + }, + 'maintainers' => {function => \&add_maintainers, + }, + 'configuration' => {function => \&add_configuration, + }, + 'suites' => {function => \&add_suite, + arguments => {'ftpdists=s' => 1, + }, + }, + 'logs' => {function => \&add_logs, + }, + 'packages' => {function => \&add_packages, + arguments => {'ftpdists=s' => 1, + 'suites=s@' => 0, + }, + }, + 'help' => {function => sub {pod2usage({verbose => 2});}} + ); + my @USAGE_ERRORS; $options{verbose} = $options{verbose} - $options{quiet}; +if ($options{progress}) { + eval "use Term::ProgressBar"; + push @USAGE_ERRORS, "You asked for a progress bar, but Term::ProgressBar isn't installed" if $@; +} + + pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS; if (exists $options{sysconfdir}) { if (not defined $options{sysconfdir} or not length $options{sysconfdir}) { - delete $ENV{PGSYSCONFDIR}; + delete $ENV{PGSYSCONFDIR}; } else { - $ENV{PGSYSCONFDIR} = $options{sysconfdir}; + $ENV{PGSYSCONFDIR} = $options{sysconfdir}; } } if (exists $options{spool_dir} and defined $options{spool_dir}) { $config{spool_dir} = $options{spool_dir}; } -chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!"; -my $verbose = $options{debug}; +my $prog_bar; +if ($options{progress}) { + $prog_bar = eval "Term::ProgressBar->new({count => 1,ETA=>q(linear)})"; + warn "Unable to initialize progress bar: $@" if not $prog_bar; +} -my $initialdir = "db-h"; -if (defined $ARGV[0] and $ARGV[0] eq "archive") { - $initialdir = "archive"; +my ($subcommand) = shift @ARGV; +if (not defined $subcommand) { + $subcommand = 'help'; + print STDERR "You must provide a subcommand; displaying usage.\n"; + pod2usage(); +} elsif (not exists $subcommands{$subcommand}) { + print STDERR "$subcommand is not a valid subcommand; displaying usage.\n"; + pod2usage(); } -if (not lockpid($config{spool_dir}.'/lock/debbugs-loadsql')) { - if ($options{quick}) { - # If this is a quick run, just exit - print STDERR "Another debbugs-loadsql is running; stopping\n" if $verbose; - exit 0; - } - print STDERR "Another debbugs-loadsql is running; stopping\n"; - exit 1; -} +binmode(STDOUT,':encoding(UTF-8)'); +binmode(STDERR,':encoding(UTF-8)'); -# connect to the database; figure out how to handle errors properly -# here. -my $schema = Debbugs::DB->connect('dbi:Pg:service='.$options{service}) or - die "Unable to connect to database: "; +my $opts = + handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments}); +$subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV); -my $time = 0; -my $start_time = time; +sub add_bugs { + my ($options,$opts,$p,$config,$argv) = @_; + chdir($config->{spool_dir}) or + die "chdir $config->{spool_dir} failed: $!"; + my $verbose = $options->{debug}; -my @dirs = ($initialdir); -my $cnt = 0; -my %tags; -my %queue; -while (my $dir = shift @dirs) { - printf "Doing dir %s ...\n", $dir if $verbose; + my $initialdir = "db-h"; - opendir(DIR, "$dir/.") or die "opendir $dir: $!"; - my @subdirs = readdir(DIR); - closedir(DIR); + if (defined $argv->[0] and $argv->[0] eq "archive") { + $initialdir = "archive"; + } + my $s = db_connect($options); + + + my $time = 0; + my $start_time = time; + my %tags; + my %severities; + my %queue; + + if ($opts->{preload}) { + my @bugs; + walk_bugs([(@{$argv}?@{$argv} : $initialdir)], + undef, + 'summary', + undef, + sub { + push @bugs,@_; + }, + 10000 + ); + $s->resultset('Bug')->quick_insert_bugs(@bugs); + } + walk_bugs([(@{$argv}?@{$argv} : $initialdir)], + $p, + 'summary', + $verbose, + sub { + my @bugs = @_; + my @bugs_to_update; + if ($options{quick}) { + for my $bug (@bugs) { + my $stat = stat(getbugcomponent($bug,'summary',$initialdir)); + if (not defined $stat) { + print STDERR "Unable to stat $bug $!\n"; + next; + } + my $rs = $s->resultset('Bug')->search({id=>$bug})->single(); + next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch(); + push @bugs_to_update, $bug; + } + } else { + @bugs_to_update = @bugs; + } + eval { + $s->txn_do(sub { + for my $bug (@bugs) { + load_bug(db => $s, + bug => $bug, + tags => \%tags, + severities => \%severities, + queue => \%queue); + } + }); + }; + if ($@) { + die "failure while trying to load bug: $@"; + } + }, + 50 + ); + handle_load_bug_queue(db => $s, + queue => \%queue); +} - my @list = map { m/^(\d+)\.summary$/?($1):() } @subdirs; - push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs; +sub add_versions { + my ($options,$opts,$p,$config,$argv) = @_; + + my $s = db_connect($options); + + my @files = @{$argv}; + $p->target(scalar @files) if $p; + for my $file (@files) { + my $fh = IO::File->new($file,'r') or + die "Unable to open $file for reading: $!"; + my @versions; + my %src_pkgs; + while (<$fh>) { + chomp; + next unless length $_; + if (/(\w[-+0-9a-z.]+) \(([^\(\) \t]+)\)/) { + push @versions, [$1,$2]; + } + } + close($fh); + my $ancestor_sv; + for my $i (reverse 0..($#versions)) { + my $sp; + if (not defined $src_pkgs{$versions[$i][0]}) { + $src_pkgs{$versions[$i][0]} = + $s->resultset('SrcPkg')->find_or_create({pkg => $versions[$i][0]}); + } + $sp = $src_pkgs{$versions[$i][0]}; + # There's probably something wrong if the source package + # doesn't exist, but we'll skip it for now + next unless defined $sp; + my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp->id(), + ver => $versions[$i][1], + }); + if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) { + $sv->update({based_on => $ancestor_sv->id()}) + } + $ancestor_sv = $sv; + } + $p->update() if $p; + } + $p->remove() if $p; +} + +sub add_debinfo { + my ($options,$opts,$p,$config,$argv) = @_; + + my @files = @{$argv}; + if (not @files) { + { + if ($opts->{0}) { + local $/ = "\0"; + } + while () { + push @files, $_; + } + } + } + return unless @files; + my $s = db_connect($options); + my %arch; + $p->target(scalar @files) if $p; + for my $file (@files) { + my $fh = IO::File->new($file,'r') or + die "Unable to open $file for reading: $!"; + my $f_stat = stat($file); + while (<$fh>) { + chomp; + next unless length $_; + my ($binname, $binver, $binarch, $srcname, $srcver) = split; + # if $srcver is not defined, this is probably a broken + # .debinfo file [they were causing #686106, see commit + # 49c85ab8 in dak.] Basically, $binarch didn't get put into + # the file, so we'll fudge it from the filename. + if (not defined $srcver) { + ($srcname,$srcver) = ($binarch,$srcname); + ($binarch) = $file =~ /_([^\.]+)\.debinfo/; + } + my $sp = $s->resultset('SrcPkg')->find_or_create({pkg => $srcname}); + # update the creation date if the data we have is earlier + my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime); + if ($ct_date < $sp->creation) { + $sp->creation($ct_date); + $sp->last_modified(DateTime->now); + $sp->update; + } + my $sv = $s->resultset('SrcVer')->find_or_create({src_pkg =>$sp->id(), + ver => $srcver}); + if (not defined $sv->upload_date() or $ct_date < $sv->upload_date()) { + $sv->upload_date($ct_date); + $sv->update; + } + my $arch; + if (defined $arch{$binarch}) { + $arch = $arch{$binarch}; + } else { + $arch = $s->resultset('Arch')->find_or_create({arch => $binarch}); + $arch{$binarch} = $arch; + } + my $bp = $s->resultset('BinPkg')->find_or_create({pkg => $binname}); + $s->resultset('BinVer')->find_or_create({bin_pkg => $bp->id(), + src_ver => $sv->id(), + arch => $arch->id(), + ver => $binver, + }); + } + $p->update() if $p; + } + $p->remove() if $p; +} - for my $bug (@list) { - print "Up to $cnt bugs...\n" if (++$cnt % 100 == 0 && $verbose); - my $stat = stat(getbugcomponent($bug,'summary',$initialdir)); - if (not defined $stat) { - print STDERR "Unable to stat $bug $!\n"; - next; +sub add_maintainers { + my ($options,$opts,$p,$config,$argv) = @_; + + my $s = db_connect($options); + my $maintainers = getsourcemaintainers(); + $p->target(2) if $p; + ## get all of the maintainers, and add the missing ones + my $maints = $s->resultset('Maintainer')-> + get_maintainers(values %{$maintainers}); + $p->update(); + my @svs = $s->resultset('SrcVer')-> + search({maintainer => undef + }, + {join => 'src_pkg', + group_by => 'me.src_pkg, src_pkg.pkg', + result_class => 'DBIx::Class::ResultClass::HashRefInflator', + columns => [qw(me.src_pkg src_pkg.pkg)], + } + )->all(); + $p->target(2+@svs) if $p; + $p->update() if $p; + for my $sv (@svs) { + if (exists $maintainers->{$sv->{src_pkg}{pkg}}) { + my $pkg = $sv->{src_pkg}{pkg}; + my $maint = $maints-> + {$maintainers->{$pkg}}; + $s->txn_do(sub {$s->resultset('SrcVer')-> + search({maintainer => undef, + 'src_pkg.pkg' => $pkg + }, + {join => 'src_pkg'} + )->update({maintainer => $maint}) + }); } - next if $stat->mtime < $time; - my $data = read_bug(bug => $bug, - location => $initialdir); - load_bug($schema,split_status_fields($data),\%tags,\%queue); + $p->update() if $p; + } + $p->remove() if $p; +} + +sub add_configuration { + my ($options,$opts,$p,$config,$argv) = @_; + + my $s = db_connect($options); + + # tags + # add all tags + my %tags; + for my $tag (@{$config{tags}}) { + $tags{$tag} = 1; + $s->resultset('Tag')->find_or_create({tag => $tag}); + } + # mark obsolete tags + for my $tag ($s->resultset('Tag')->search_rs()->all()) { + next if exists $tags{$tag->tag}; + $tag->obsolete(1); + $tag->update; + } + + # severities + my %sev_names; + my $order = -1; + for my $sev_name (($config{default_severity},@{$config{severity_list}})) { + # add all severitites + my $sev = $s->resultset('Severity')->find_or_create({severity => $sev_name}); + # mark strong severities + if (grep {$_ eq $sev_name} @{$config{strong_severities}}) { + $sev->strong(1); + } + $sev->ordering($order); + $sev->update(); + $order++; + $sev_names{$sev_name} = 1; + } + # mark obsolete severities + for my $sev ($s->resultset('Severity')->search_rs()->all()) { + next if exists $sev_names{$sev->severity()}; + $sev->obsolete(1); + $sev->update(); + } +} + +sub add_suite { + my ($options,$opts,$p,$config,$argv) = @_; + # suites + + my $s = db_connect($options); + my $dist_dir = IO::Dir->new($opts->{ftpdists}); + my @dist_names = + grep { $_ !~ /^\./ and + -d $opts->{ftpdists}.'/'.$_ and + not -l $opts->{ftpdists}.'/'.$_ + } $dist_dir->read; + while (my $dist = shift @dist_names) { + my $dist_dir = $opts->{ftpdists}.'/'.$dist; + my ($dist_info,$package_files) = + read_release_file($dist_dir.'/Release'); + load_suite($s,$dist_info); + } +} + +sub add_logs { + my ($options,$opts,$p,$config,$argv) = @_; + + chdir($config->{spool_dir}) or + die "chdir $config->{spool_dir} failed: $!"; + + my $verbose = $options->{debug}; + + my $initialdir = "db-h"; + + if (defined $argv->[0] and $argv->[0] eq "archive") { + $initialdir = "archive"; } + my $s = db_connect($options); + + + my $time = 0; + my $start_time = time; + + walk_bugs([(@{$argv}?@{$argv} : $initialdir)], + $p, + 'log', + $verbose, + sub { + my $bug = shift; + my $stat = stat(getbugcomponent($bug,'log',$initialdir)); + if (not defined $stat) { + print STDERR "Unable to stat $bug $!\n"; + next; + } + if ($options{quick}) { + my $rs = $s->resultset('Bug')->search({bug=>$bug})->single(); + next if defined $rs and $stat->mtime <= $rs->last_modified()->epoch(); + } + eval { + load_bug_log(db => $s, + bug => $bug); + }; + if ($@) { + die "failure while trying to load bug log $bug\n$@"; + } + }); } -hanlde_queue($schema,\%queue); - -sub load_bug { - my ($s,$data,$tags,$queue) = @_; - my $s_data = split_status_fields($data); - my @tags; - for my $tag (make_list($s_data->{keywords})) { - next unless defined $tag and length $tag; - # this allows for invalid tags. But we'll use this to try to - # find those bugs and clean them up - if (not exists $tags->{$tag}) { - $tags->{$tag} = $s->resultset('Tag')->find_or_create({tag => $tag}); + +sub add_packages { + my ($options,$opts,$p,$config,$argv) = @_; + + my $dist_dir = IO::Dir->new($opts->{ftpdists}); + my @dist_names = + grep { $_ !~ /^\./ and + -d $opts->{ftpdists}.'/'.$_ and + not -l $opts->{ftpdists}.'/'.$_ + } $dist_dir->read; + my %s_p; + while (my $dist = shift @dist_names) { + my $dist_dir = $opts->{ftpdists}.'/'.$dist; + my ($dist_info,$package_files) = + read_release_file($dist_dir.'/Release'); + $s_p{$dist_info->{Codename}} = $package_files; + } + my $tot = 0; + for my $suite (keys %s_p) { + for my $component (keys %{$s_p{$suite}}) { + $tot += scalar keys %{$s_p{$suite}{$component}}; } - push @tags, $tags->{$tag}; } - my $bug = {id => $data->{bug_num}, - creation => DateTime->from_epoch(epoch => $data->{date}), - log_modified => DateTime->from_epoch(epoch => $data->{log_modified}), - last_modified => DateTime->from_epoch(epoch => $data->{last_modified}), - archived => $data->{archived}, - (defined $data->{unarchived} and length($data->{unarchived}))?(unarchived => DateTime->from_epoch(epoch => $data->{unarchived})):(), - forwarded => $data->{forwarded} // '', - summary => $data->{summary} // '', - outlook => $data->{outlook} // '', - subject => $data->{subject} // '', - done => $data->{done} // '', - owner => $data->{owner} // '', - severity => length($data->{severity}) ? $data->{severity} : $config{default_severity}, - }; - $s->resultset('Bug')->update_or_create($bug); - $s->txn_do(sub { - for my $ff (qw(found fixed)) { - my @elements = $s->resultset('BugVer')->search({bug_id => $data->{bug_num}, - found => $ff eq 'found'?1:0, - }); - my %elements_to_delete = map {($elements[$_]->ver_string(),$_)} 0..$#elements; - my @elements_to_add; - for my $version (@{$data->{"${ff}_versions"}}) { - if (exists $elements_to_delete{$version}) { - delete $elements_to_delete{$version}; - } else { - push @elements_to_add,$version; - } - } - for my $element (keys %elements_to_delete) { - $elements_to_delete{$element}->delete(); - } - for my $element (@elements_to_add) { - # find source package and source version id - my $ne = $s->resultset('BugVer')->new_result({bug_id => $data->{bug_num}, - ver_string => $element, - found => $ff eq 'found'?1:0, - } - ); - if (my ($src_pkg,$src_ver) = $element =~ m{^([^\/]+)/(.+)$}) { - my $src_pkg_e = $s->resultset('SrcPkg')->single({pkg => $src_pkg}); - if (defined $src_pkg_e) { - $ne->src_pkg_id($src_pkg_e->id()); - my $src_ver_e = $s->resultset('SrcVer')->single({src_pkg_id => $src_pkg_e->id(), - ver => $src_ver - }); - $ne->src_ver_id($src_ver_e->id()) if defined $src_ver_e; - } - } - $ne->insert(); - } - } - }); - $s->txn_do(sub { - $s->resultset('BugTag')->search({bug_id => $data->{bug_num}})->delete(); - $s->populate(BugTag => [[qw(bug_id tag_id)], map {[$data->{bug_num}, $_->id()]} @tags]); - }); - # because these bugs reference other bugs which might not exist - # yet, we can't handle them until we've loaded all bugs. queue - # them up. - $queue->{merged}{$data->{bug_num}} = [@{$data->{mergedwith}}]; - $queue->{blocks}{$data->{bug_num}} = [@{$data->{blocks}}]; - - print STDERR "Handled $data->{bug_num}\n"; - # still need to handle merges, versions, etc. + $p->target($tot) if $p; + my $i = 0; + my $avg_pkgs = 0; + my $tot_suites = scalar keys %s_p; + my $done_suites=0; + my $completed_pkgs=0; + # parse packages files + for my $suite (keys %s_p) { + my @pkgs; + for my $component (keys %{$s_p{$suite}}) { + my @archs = keys %{$s_p{$suite}{$component}}; + if (grep {$_ eq 'source'} @archs) { + @archs = ('source',grep {$_ ne 'source'} @archs); + } + for my $arch (@archs) { + my $pfh = open_compressed_file($s_p{$suite}{$component}{$arch}) or + die "Unable to open $s_p{$suite}{$component}{$arch} for reading: $!"; + local $_; + local $/ = ''; # paragraph mode + while (<$pfh>) { + my %pkg; + for my $field (qw(Package Maintainer Version Source)) { + /^\Q$field\E: (.*)/m; + $pkg{$field} = $1; + } + next unless defined $pkg{Package} and + defined $pkg{Version}; + push @pkgs,[$arch,$component,\%pkg]; + } + } + } + my $s = db_connect($options); + if ($avg_pkgs==0) { + $avg_pkgs = @pkgs; + } + $p->target($avg_pkgs*($tot_suites-$done_suites-1)+ + $completed_pkgs+@pkgs) if $p; + load_packages($s, + $suite, + \@pkgs, + $p); + $avg_pkgs=($avg_pkgs*$done_suites + @pkgs)/($done_suites+1); + $completed_pkgs += @pkgs; + $done_suites++; + } + $p->remove() if $p; } -sub handle_queue{ - my ($s,$queue) = @_; - my %queue_types = - (merged => {set => 'BugMerged', - columns => [qw(bug_id merged)], - bug_id => 'bug_id', - }, - blocks => {set => 'BugBlock', - columns => [qw(bug_id blocks)], - bug_id => 'bug_id', - }, - ); - for my $queue_type (keys %queue_types) { - for my $bug (%{$queue->{$queue_type}}) { - my $qt = $queue_types{$queue_type}; - $s->txn_do(sub { - $s->resultset($qt->{set})->search({$qt->{bug_id},$bug})->delete(); - $s->populate($qt->{set},[[@{$qt->{columns}}],map {[$bug,$_]} @{$queue->{$queue_type}{$bug}}]) if - @{$queue->{$queue_type}{$bug}}; - } - ); +sub handle_subcommand_arguments { + my ($argv,$args) = @_; + my $subopt = {}; + Getopt::Long::GetOptionsFromArray($argv, + $subopt, + keys %{$args}, + ); + my @usage_errors; + for my $arg (keys %{$args}) { + next unless $args->{$arg}; + my $r_arg = $arg; # real argument name + $r_arg =~ s/[=\|].+//g; + if (not defined $subopt->{$r_arg}) { + push @usage_errors, "You must give a $r_arg option"; + } + } + pod2usage(join("\n",@usage_errors)) if @usage_errors; + return $subopt; +} + +sub get_lock{ + my ($subcommand,$config,$options) = @_; + if (not lockpid($config->{spool_dir}.'/lock/debbugs-loadsql-$subcommand')) { + if ($options->{quick}) { + # If this is a quick run, just exit + print STDERR "Another debbugs-loadsql is running; stopping\n" if $options->{verbose}; + exit 0; + } + print STDERR "Another debbugs-loadsql is running; stopping\n"; + exit 1; + } +} + +sub db_connect { + my ($options) = @_; + # connect to the database; figure out how to handle errors + # properly here. + my $s = Debbugs::DB->connect($options->{service}) or + die "Unable to connect to database: "; +} + +sub read_release_file { + my ($file) = @_; + # parse release + my $rfh = open_compressed_file($file) or + die "Unable to open $file for reading: $!"; + my %dist_info; + my $in_sha1; + my %p_f; + while (<$rfh>) { + chomp; + if (s/^(\S+):\s*//) { + if ($1 eq 'SHA1'or $1 eq 'SHA256') { + $in_sha1 = 1; + next; + } + $dist_info{$1} = $_; + } elsif ($in_sha1) { + s/^\s//; + my ($sha,$size,$f) = split /\s+/,$_; + next unless $f =~ /(?:Packages|Sources)(?:\.gz|\.xz)$/; + next unless $f =~ m{^([^/]+)/([^/]+)/([^/]+)$}; + my ($component,$arch,$package_source) = ($1,$2,$3); + $arch =~ s/binary-//; + next if exists $p_f{$component}{$arch}; + $p_f{$component}{$arch} = File::Spec->catfile(dirname($file),$f); } } + return (\%dist_info,\%p_f); } +sub walk_bugs { + my ($dirs,$p,$what,$verbose,$sub,$n) = @_; + my @dirs = @{$dirs}; + my $tot_dirs = @dirs; + my $done_dirs = 0; + my $avg_subfiles = 0; + my $completed_files = 0; + $n //= 1; + while (my $dir = shift @dirs) { + printf "Doing dir %s ...\n", $dir if $verbose; + + opendir(DIR, "$dir/.") or die "opendir $dir: $!"; + my @subdirs = readdir(DIR); + closedir(DIR); + + my @list = map { m/^(\d+)\.$what$/?($1):() } @subdirs; + $tot_dirs -= @dirs; + push @dirs, map { m/^(\d+)$/ && -d "$dir/$1"?("$dir/$1"):() } @subdirs; + $tot_dirs += @dirs; + if ($avg_subfiles == 0) { + $avg_subfiles = @list; + } + + $p->target($avg_subfiles*($tot_dirs-$done_dirs)+$completed_files+@list) if $p; + $avg_subfiles = ($avg_subfiles * $done_dirs + @list) / ($done_dirs+1); + $done_dirs += 1; + + my $it = natatime $n,@list; + while (my @bugs = $it->()) { + $sub->(@bugs); + $completed_files += scalar @bugs; + $p->update($completed_files) if $p; + print "Up to $completed_files bugs...\n" + if ($completed_files % 100 == 0 && $verbose); + } + } + $p->remove() if $p; +} + + __END__