X-Git-Url: https://git.donarmstrong.com/?p=bugscan.git;a=blobdiff_plain;f=scanlib.pm;h=cc32b457839033ece9f22cf3b14cbfa72355d09b;hp=6978dae17c0d83fb382ec9596fd5ce559580b2c8;hb=refs%2Fheads%2Fscanlib_fixup;hpb=c8231fc0ca856194ccc90a798120bdbd9b476c98 diff --git a/scanlib.pm b/scanlib.pm index 6978dae..cc32b45 100644 --- a/scanlib.pm +++ b/scanlib.pm @@ -10,6 +10,9 @@ # %section - map from packagename to section in the FTP-site # %packagelist - map from packagename to bugreports +use warnings; +use strict; + use lib qw(/org/bugs.debian.org/perl); use LWP::UserAgent; use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522); @@ -17,9 +20,13 @@ use Debbugs::Packages; use Debbugs::Versions; use Debbugs::Status; use Fcntl qw(O_RDONLY); -use strict; -use warnings; -require bugcfg; +use IO::File; +use IO::Dir; + +use File::Basename; +use lib dirname(__FILE__); +use bugcfg; + package scanlib; our (%maintainer,%section,%packagelist,%debbugssection,%bugs); @@ -46,14 +53,10 @@ sub readmaintainers() { } -sub readsources() { - my $root; # Root of archive we are scanning - my $archive; # Name of archive we are scanning - my $sect; # Name of current section +sub readsources { + my ($root,$archive) = @_; - $root=shift; - $archive=shift; - for $sect (@bugcfg::sections) { + for my $sect (@bugcfg::sections) { open(P, "zcat $root/$sect/source/Sources.gz|") or die open "open: $sect sourcelist: $!\n"; while (
) { @@ -66,16 +69,10 @@ sub readsources() { } } -sub readpackages() { - my $root; # Root of archive we are scanning - my $archive; # Name of archive we are scanning - my $sect; # Name of current section - my $arch; # Name of current architecture - - $root=shift; - $archive=shift; - for $arch ( @bugcfg::architectures ) { - for $sect ( @bugcfg::sections) { +sub readpackages { + my ($root,$archive) = @_; + for my $arch ( @bugcfg::architectures ) { + for my $sect ( @bugcfg::sections) { open(P, "zcat $root/$sect/binary-$arch/Packages.gz|") or die "open: $root/$sect/binary-$arch/Packages.gz: $!\n"; while (
) { @@ -88,14 +85,23 @@ sub readpackages() { close(P); } } + # handle the source packages + for my $sect (@bugcfg::sections) { + my $fh; + open($fh,'-|','zcat',"$root/$sect/source/Sources.gz") or + die "Unable to open zcat $root/$sect/source/Sources.gz for reading: $!"; + while (<$fh>) { + chomp; + next unless m/^Package:\s/; # We're only interested in the packagenames + s/^Package:\s*//; # Strip the fieldname + $section{$_} = "$archive/$sect"; + } + } } -sub readdebbugssources() { - my $file; - my $archive; +sub readdebbugssources { + my ($file,$archive) = @_; - $file=shift; - $archive=shift; open(P, $file) or die "open: $file: $!\n"; while (
) {
@@ -136,24 +142,22 @@ sub scanspool() {
}
sub scanspooldir {
- my ($dir) = @_;
- my $f; # While we're currently processing
- my @list; # List of files to process
+ my ($dir,$bugs) = @_;
my $skip; # Flow control
my $walk; # index variable
my $taginfo; # Tag info
my @archs_with_source = ( @bugcfg::architectures, 'source' );
- chdir($dir) or die "chdir $dir: $!\n";
+# chdir($dir) or die "chdir $dir: $!\n";
- opendir(DIR, $dir) or die "opendir $dir: $!\n";
- @list = grep { s/\.summary$// }
- grep { m/^\d+\.summary$/ }
- readdir(DIR);
- closedir(DIR);
+ my $d = IO::Dir->new($dir) or die "Unable to opendir: $dir $!\n";
+ my @list = grep { s/\.summary$// }
+ grep { m/^\d+\.summary$/ }
+ $d->read;
+ $d->close;
- for $f (@list) {
+ for my $f (@list) {
my $bug = Debbugs::Status::read_bug(summary => "$f.summary");
next if (!defined($bug));
@@ -176,11 +180,10 @@ sub scanspooldir {
}
next if $skip==1;
- my %disttags = ();
- $disttags{'oldstable'} = grep(/^etch$/, @tags);
- $disttags{'stable'} = grep(/^lenny$/, @tags);
- $disttags{'testing'} = grep(/^squeeze$/, @tags);
- $disttags{'unstable'} = grep(/^sid$/, @tags);
+ my %disttags = ();
+ for my $release (qw(oldstable stable testing unstable)) {
+ $disttags{$release} = grep(/^$bugcfg::debian_releases->{$release}$/, @tags);
+ }
$disttags{'experimental'} = grep(/^experimental$/, @tags);
# default according to vorlon 2007-06-17
@@ -194,7 +197,7 @@ sub scanspooldir {
if (defined($section{$bug->{'package'}}) && $section{$bug->{'package'}} eq 'pseudo') {
# versioning information makes no sense for pseudo packages,
# just use the tags
- for my $dist qw(oldstable stable testing unstable experimental) {
+ for my $dist (qw(oldstable stable testing unstable experimental)) {
$bi->{$dist} = $disttags{$dist};
}
next if (length($bug->{'done'}));
@@ -202,7 +205,7 @@ sub scanspooldir {
my $affects_any = 0;
# only bother to check the versioning status for the distributions indicated by the tags
- for my $dist qw(oldstable stable testing unstable experimental) {
+ for my $dist (qw(oldstable stable testing unstable experimental)) {
local $SIG{__WARN__} = sub {};
$bi->{$dist} = 0;
@@ -228,7 +231,8 @@ sub scanspooldir {
next if !$affects_any;
}
- for my $keyword qw(pending patch help moreinfo unreproducible security upstream etch-ignore lenny-ignore squeeze-ignore) {
+ for my $keyword (qw(pending patch help moreinfo unreproducible security upstream),
+ map {$bugcfg::debian_releases->{$_}.'-ignore'} keys %{$bugcfg::debian_releases}) {
$bi->{$keyword} = grep(/^$keyword$/, @tags);
}
@@ -245,8 +249,9 @@ sub scanspooldir {
my $taginfo = get_taginfo($bi);
my $relinfo = get_relinfo($bi);
- $bugs{$f} = $bi;
+ $bugs->{$f} = $bi;
}
+ return $bugs;
}
@@ -256,7 +261,9 @@ sub readstatus {
or die "$filename: $!";
while (1) {
- chomp (my $type =