- 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});
- my $sv = $s->resultset('SrcVer')->find_or_create({src_pkg =>$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 => $bp->id(),
- src_ver => $sv->id(),
- arch => $arch->id(),
- ver => $binver,
- });
- }
- $p->update() 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;