X-Git-Url: https://git.donarmstrong.com/?p=bugscan.git;a=blobdiff_plain;f=scanlib.pm;h=7cd2e63386c39cb3fa2abebef87f3391e0439c08;hp=60e4cf47837d454823a022f86de99c08b47f2962;hb=61dc25d9ca3fe9ac4a7fdef02d2e414484fb9aeb;hpb=179fea92bb01339575f3666554e0703ca5cc3881 diff --git a/scanlib.pm b/scanlib.pm index 60e4cf4..7cd2e63 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,11 @@ use Debbugs::Packages; use Debbugs::Versions; use Debbugs::Status; use Fcntl qw(O_RDONLY); -use strict; -use warnings; -require bugcfg; + +use File::Basename; +use lib dirname(__FILE__); +use bugcfg; + package scanlib; our (%maintainer,%section,%packagelist,%debbugssection,%bugs); @@ -46,14 +51,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 (

) { @@ -96,12 +97,9 @@ sub readpackages { } } -sub readdebbugssources() { - my $file; - my $archive; +sub readdebbugssources { + my ($file,$archive) = @_; - $file=shift; - $archive=shift; open(P, $file) or die "open: $file: $!\n"; while (

) { @@ -182,11 +180,10 @@ sub scanspooldir { } next if $skip==1; - my %disttags = (); - $disttags{'oldstable'} = grep(/^lenny$/, @tags); - $disttags{'stable'} = grep(/^squeeze$/, @tags); - $disttags{'testing'} = grep(/^wheezy$/, @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 @@ -200,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'})); @@ -208,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; @@ -234,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 wheezy-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); } @@ -326,13 +324,13 @@ sub wwwname() { sub check_worry { my ($bi) = @_; - return ($bi->{'testing'} && !$bi->{'wheezy-ignore'}); + return ($bi->{'testing'} && !$bi->{$bugcfg::debian_releases->{testing}.'-ignore'}); } sub check_worry_stable { my ($bi) = @_; - return ($bi->{'stable'} && !$bi->{'squeeze-ignore'}); + return ($bi->{'stable'} && !$bi->{$bugcfg::debian_releases->{stable}.'-ignore'}); } sub check_worry_unstable { @@ -352,7 +350,7 @@ sub get_taginfo { $taginfo .= $bi->{'unreproducible'} ? "R" : " "; $taginfo .= $bi->{'security'} ? "S" : " "; $taginfo .= $bi->{'upstream'} ? "U" : " "; - $taginfo .= ($bi->{'wheezy-ignore'} || $bi->{'squeeze-ignore'}) ? "I" : " "; + $taginfo .= ($bi->{$bugcfg::debian_releases->{stable}.'-ignore'} || $bi->{$bugcfg::debian_releases->{testing}.'-ignore'}) ? "I" : " "; return $taginfo; } @@ -361,7 +359,7 @@ sub get_relinfo { my $bi = shift; my $relinfo = ""; - for my $dist qw(oldstable stable testing unstable experimental) { + for my $dist (qw(oldstable stable testing unstable experimental)) { $relinfo .= uc(substr($dist, 0, 1)) if $bi->{$dist}; }