X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=bin%2Fdebbugs-loadsql;h=fe9ce6b0177200f93940143fa34c52eb8f4b4523;hb=a38d37cc8d08e6ea3ff089195f9028f7a5305939;hp=293f644d7c92d74bfa28690b42fe2e7dd61ba73c;hpb=ace36e4b06216688748a3966e0660f94cd8e4dd8;p=debbugs.git diff --git a/bin/debbugs-loadsql b/bin/debbugs-loadsql index 293f644..fe9ce6b 100755 --- a/bin/debbugs-loadsql +++ b/bin/debbugs-loadsql @@ -17,10 +17,13 @@ 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 @@ -29,6 +32,54 @@ debbugs-loadsql [options] --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 @@ -60,7 +111,7 @@ debbugs configuration file. Output more information about what is happening. Probably not useful if you also set --progress. -=item B<--debug, -d +=item B<--debug, -d> Debug verbosity. @@ -80,15 +131,33 @@ Display this manual. use vars qw($DEBUG); -use Debbugs::Common qw(checkpid lockpid get_hashname getparsedaddrs getbugcomponent make_list); +# if we're running out of git, we want to use the git base directory as the +# first INC directory. If you're not running out of git, or someone has given a +# non-absolute INC, don't do that. +use FindBin; +use if (-d $FindBin::Bin.'/../.git/' && $INC[0] =~ m#^/#), + lib => $FindBin::Bin.'/../'; + +use Debbugs::Common (qw(checkpid lockpid get_hashname getparsedaddrs), + qw(getbugcomponent make_list getsourcemaintainers), + qw(getbuglocation), + qw(walk_bugs), + 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 handle_load_bug_queue); +use Debbugs::DB::Load qw(:load_bug :load_package :load_suite); use DateTime; use File::stat; - +use File::Basename; +use File::Spec; +use File::Find; +use IO::Dir; +use IO::File; +use IO::Uncompress::AnyUncompress; +use Encode qw(decode_utf8); +use List::AllUtils qw(natatime); my %options = (debug => 0, @@ -97,22 +166,22 @@ my %options = verbose => 0, quiet => 0, quick => 0, - service => 'debbugs', + service => $config{debbugs_db}, progress => 0, ); -my $gop = Getopt::Long::Parser->new(); -$gop->configure('pass_through'); -$gop->getoptions(\%options, - 'quick|q', - 'service|s', - 'sysconfdir|c', - 'progress!', - 'spool_dir|spool-dir=s', - 'verbose|v+', - 'quiet+', - 'debug|d+','help|h|?','man|m'); -$gop->getoptions('default'); +Getopt::Long::Configure('pass_through'); +GetOptions(\%options, + 'quick|q', + 'service|s=s', + 'dsn=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}; @@ -121,17 +190,35 @@ $DEBUG = $options{debug}; my %subcommands = ('bugs' => {function => \&add_bugs, + arguments => {'preload' => 0, + 'bugs=s@' => 0, + }, }, 'versions' => {function => \&add_versions, }, 'debinfo' => {function => \&add_debinfo, + arguments => {'0|null' => 0, + 'debinfo_dir|debinfo-dir=s' => 0, + }, }, 'maintainers' => {function => \&add_maintainers, }, 'configuration' => {function => \&add_configuration, }, + 'suites' => {function => \&add_suite, + arguments => {'ftpdists=s' => 1, + }, + }, 'logs' => {function => \&add_logs, }, + 'bugs_and_logs' => {function => \&add_bugs_and_logs, + }, + 'packages' => {function => \&add_packages, + arguments => {'ftpdists=s' => 1, + 'suites=s@' => 0, + }, + }, + 'help' => {function => sub {pod2usage({verbose => 2});}} ); my @USAGE_ERRORS; @@ -160,13 +247,26 @@ if (exists $options{spool_dir} and defined $options{spool_dir}) { 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 $p; + warn "Unable to initialize progress bar: $@" if not $prog_bar; +} + + +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(); } +binmode(STDOUT,':encoding(UTF-8)'); +binmode(STDERR,':encoding(UTF-8)'); my $opts = - handle_arguments(\@ARGV,$subcommands{$subcommand}{arguments},$gop); -$subcommands{$subcommand}{function}->($options,$opts,$prog_bar,$config,\@ARGV); + handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments}); +$subcommands{$subcommand}{function}->(\%options,$opts,$prog_bar,\%config,\@ARGV); sub add_bugs { my ($options,$opts,$p,$config,$argv) = @_; @@ -175,73 +275,63 @@ sub add_bugs { my $verbose = $options->{debug}; - my $initialdir = "db-h"; - - if (defined $argv->[0] and $argv->[0] eq "archive") { - $initialdir = "archive"; + my @dirs; + if (@{$argv}) { + @dirs = @{$argv}; + } elsif (not defined $opts->{bugs}) { + @dirs = "db-h" } - my $s = db_connect($options); + $opts->{bugs} //= []; - - my $time = 0; - my $start_time = time; + my $s = db_connect($options); - my @dirs = (@{$argv}?@{$argv} : $initialdir); - my $cnt = 0; my %tags; my %severities; my %queue; - my $tot_dirs = @{$argv}? @{$argv} : 0; - my $done_dirs = 0; - my $avg_subfiles = 0; - my $completed_files = 0; - 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+)\.summary$/?($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; - - for my $bug (@list) { - $completed_files++; - $p->update($completed_files) if $p; - 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; - } - next if $stat->mtime < $time; - my $data = read_bug(bug => $bug, - location => $initialdir); - eval { - load_bug(db => $s, - data => split_status_fields($data), - tags => \%tags, - severities => \%severities, - queue => \%queue); - }; - if ($@) { - use Data::Dumper; - print STDERR Dumper($data) if $DEBUG; - die "failure while trying to load bug $bug\n$@"; - } - } + if ($opts->{preload}) { + my @bugs; + walk_bugs(dirs => [@dirs], + bugs => $opts->{bugs}, + callback => sub { + push @bugs,@_; + }, + bugs_per_call => 10000 + ); + $s->resultset('Bug')->quick_insert_bugs(@bugs); } - $p->remove() if $p; + walk_bugs(dirs => [@dirs], + bugs => $opts->{bugs}, + progress_bar => $p, + $verbose?(logging=>\*STDERR):(), + callback => + sub { + my @bugs = @_; + my @bugs_to_update; + if ($options{quick}) { + @bugs_to_update = + bugs_to_update($s,@bugs); + } else { + @bugs_to_update = @bugs; + } + eval { + $s->txn_do(sub { + for my $bug (@bugs_to_update) { + load_bug(db => $s, + bug => $bug, + tags => \%tags, + severities => \%severities, + queue => \%queue); + } + }); + }; + if ($@) { + die "failure while trying to load bug: $@"; + } + }, + bugs_per_call => 50 + ); handle_load_bug_queue(db => $s, queue => \%queue); } @@ -252,7 +342,7 @@ sub add_versions { my $s = db_connect($options); my @files = @{$argv}; - $p->target(@files) if $p; + $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: $!"; @@ -271,19 +361,21 @@ sub add_versions { my $sp; if (not defined $src_pkgs{$versions[$i][0]}) { $src_pkgs{$versions[$i][0]} = - $s->resultset('SrcPkg')->find({pkg => $versions[$i][0]}); + $s->resultset('SrcPkg')-> + get_or_create_src_pkg_id($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_id=>$sp->id(), + last if not defined $sp; + my $sv = $s->resultset('SrcVer')->find({src_pkg=>$sp, ver => $versions[$i][1], }); + last if not defined $sv; if (defined $ancestor_sv and defined $sv and not defined $sv->based_on()) { - $sv->update({based_on => $ancestor_sv->id()}) + $sv->update({based_on => $ancestor_sv}) } - $ancestor_sv = $sv; + $ancestor_sv = $sv->id(); } $p->update() if $p; } @@ -294,42 +386,80 @@ sub add_debinfo { my ($options,$opts,$p,$config,$argv) = @_; my @files = @{$argv}; - - my %arch; - $p->target(@files) if $p; - for my $file (@files) { - my $fh = IO::File->new($file,'r') or - die "Unable to open $file for reading: $!"; - 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}); - my $sv = $s->resultset('SrcVer')->find_or_create({src_pkg_id=>$sp->id(), - ver => $srcver}); - 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_id => $bp->id(), - src_ver_id => $sv->id(), - arch_id => $arch->id(), - ver => $binver, - }); - } - $p->update() if $p; + if (exists $opts->{debinfo_dir} and not @files) { + find(sub { + if (-f $_ and /\.debinfo$/) { + push @files, $File::Find::name; + } + }, + $opts->{debinfo_dir} + ); + } + if (not @files) { + { + local $/ = "\n"; + local $/ = "\0" if $opts->{0}; + while () { + s/\n$// unless $opts->{0}; + s/\0$// if $opts->{0}; + push @files, $_; + } + } + } + return unless @files; + my $s = db_connect($options); + $p->target(scalar @files) if $p; + my $it = natatime 100, @files; + while (my @v = $it->()) { + my %cache; + my @debinfos; +FILE: for my $file (@v) { + my $fh = IO::File->new($file,'r') or + die "Unable to open $file for reading: $!"; + my $f_stat = stat($file); + my $ct_date = DateTime->from_epoch(epoch => $f_stat->ctime); + my @file_debinfos; + 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 =~ /_([a-z0-9-]+)\.debinfo/; + } + # It turns out that there are debinfo files which are horribly + # screwed up, and have junk in them. We need to discard them + # completely + if (not defined $srcname or + not defined $srcver or + not defined $binname or + not defined $binver or + not defined $binarch or + $srcname !~ /^$config{package_name_re}$/o or + $binname !~ /^$config{package_name_re}$/o or + $srcver !~ /^$config{package_version_re}$/o or + $binver !~ /^$config{package_version_re}$/o + ) { + print STDERR "malformed debinfo: $file\n$_\n"; + next FILE; + } + push @file_debinfos, + [$binname,$binver,$binarch,$srcname,$srcver,$ct_date]; + } + push @debinfos, + @file_debinfos; + } + $s->txn_do( + sub { + for my $di (@debinfos) { + Debbugs::DB::Load::load_debinfo($s,@{$di}[0..5],\%cache); + } + }); + $p->update($p->last_update()+@v) if $p; } $p->remove() if $p; } @@ -337,44 +467,295 @@ sub add_debinfo { sub add_maintainers { my ($options,$opts,$p,$config,$argv) = @_; - my $maintainers = getmaintainers(); - $p->target(scalar keys %{$maintainers}) if $p; - for my $pkg (keys %{$maintainers}) { - my $maint = $maintainers->{$pkg}; - # see if a maintainer already exists; if so, we don't do - # anything here - my $maint_r = $s->resultset('Maintainer')-> - find({name => $maint}); - if (not defined $maint_r) { - # get e-mail address of maintainer - my $e_mail = getparsedaddrs($maint); - # find correspondent - my $correspondent = $s->resultset('Correspondent')-> - find_or_create({addr => $e_mail}); - $maint_r = - $s->resultset('Maintainer')-> - find_or_create({name => $maint, - correspondent => $correspondent, - }); - } - # add the maintainer to the source package - $p->update() if $p; + 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() if $p; + 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}) + }); + } + $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); + + walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)], + progress_bar => $p, + bug_file => 'log', + $verbose?(logging => \*STDERR):(), + callback => + 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({id=>$bug})->single(); + return 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$@"; + } + }); +} + +sub add_bugs_and_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 %tags; + my %severities; + my %queue; + + walk_bugs(dirs => [(@{$argv}?@{$argv} : $initialdir)], + progress_bar => $p, + $verbose?(logging => \*STDERR):(), + callback => + sub { + my @bugs = @_; + my @bugs_to_update; + if ($options{quick}) { + @bugs_to_update = + bugs_to_update($s,@bugs); + } else { + @bugs_to_update = @bugs; + } + eval { + $s->txn_do(sub { + for my $bug (@bugs_to_update) { + load_bug(db => $s, + bug => $bug, + tags => \%tags, + severities => \%severities, + queue => \%queue); + } + }); + }; + if ($@) { + die "failure while trying to load bug: $@"; + } + for my $bug (@bugs) { + 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({id=>$bug})->single(); + return 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$@"; + } + } + }, + bugs_per_call => 50, + ); + handle_load_bug_queue(db=>$s, + queue => \%queue, + ); + +} + +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}}; + } + } + $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_subcommand_arguments { - my ($argv,$args,$gop) = @_; + my ($argv,$args) = @_; my $subopt = {}; - $gop->getoptionsfromarray($argv, + Getopt::Long::GetOptionsFromArray($argv, $subopt, keys %{$args}, ); @@ -408,10 +789,57 @@ sub db_connect { my ($options) = @_; # connect to the database; figure out how to handle errors # properly here. - my $s = Debbugs::DB->connect('dbi:Pg:service='.$options->{service}) or + my $s = Debbugs::DB->connect($options->{dsn} // + $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 bugs_to_update { + my ($s,@bugs) = @_; + my @bugs_to_update; + for my $bug (@bugs) { + my $stat = stat(getbugcomponent($bug,'summary',getbuglocation($bug,'summary'))); + 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; + } + @bugs_to_update; +} __END__