) { +sub readsources { + my ($root,$archive) = @_; + + for my $sect (@bugcfg::sections) { + my $p = glob_compressed_fh("$root/$sect/source/Sources.*"); + while (<$p>) { chomp; next unless m/^Package:\s/; s/^Package:\s*//; # Strip the fieldname $section{$_} = "$archive/$sect"; } - close (P); + close ($p); } } -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) { - open(P, "zcat $root/$sect/binary-$arch/Packages.gz|") - or die "open: $root/$sect/binary-$arch/Packages.gz: $!\n"; - while (
) { +sub readpackages { + my ($root,$archive) = @_; + for my $arch ( @bugcfg::architectures ) { + for my $sect ( @bugcfg::sections) { + my $p = glob_compressed_fh("$root/$sect/binary-$arch/Packages.*"); + while (<$p>) { chomp; next unless m/^Package:\s/; # We're only interested in the packagenames s/^Package:\s*//; # Strip the fieldname $section{$_} = "$archive/$sect"; print "$root/$sect/binary-$arch/Packages.gz\n" if ($_ eq 'xtla'); } - close(P); + close($p); } } + # handle the source packages + for my $sect (@bugcfg::sections) { + my $fh = glob_compressed_fh("$root/$sect/source/Sources.*"); + 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 (
) { @@ -135,7 +147,7 @@ sub scanspool() { } -sub scanspooldir() { +sub scanspooldir { my ($dir) = @_; my $f; # While we're currently processing my @list; # List of files to process @@ -176,11 +188,10 @@ sub scanspooldir() { } next if $skip==1; - my %disttags = (); - $disttags{'oldstable'} = grep(/^sarge$/, @tags); - $disttags{'stable'} = grep(/^etch$/, @tags); - $disttags{'testing'} = grep(/^lenny$/, @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 +205,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 +213,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 +239,8 @@ sub scanspooldir() { next if !$affects_any; } - for my $keyword qw(pending patch help moreinfo unreproducible security upstream etch-ignore lenny-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); } @@ -238,7 +250,7 @@ sub scanspooldir() { } for my $package (split /[,\s]+/, $bug->{'package'}) { - $_= $package; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9]/; + $_= $package; y/A-Z/a-z/; $_= $` if m/[^-+._:a-z0-9]/; push @{$packagelist{$_}}, $f; } @@ -250,7 +262,7 @@ sub scanspooldir() { } -sub readstatus() { +sub readstatus { my $filename = shift; open STATUS, "<", $filename or die "$filename: $!"; @@ -277,7 +289,7 @@ sub readstatus() { $bugs{$bug->{'number'}} = $bug; for my $package (split /[,\s]+/, $bug->{'package'}) { - $_= $package; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9]/; + $_= $package; y/A-Z/a-z/; $_= $` if m/[^-+._:a-z0-9]/; push @{$packagelist{$_}}, $bug->{'number'}; } } @@ -303,14 +315,14 @@ sub htmlsanit { return $in; } -sub wwwnumber() { +sub wwwnumber { my $number = shift; # Number of bug to html-ize "' . htmlsanit($number) . ''; } -sub wwwname() { +sub wwwname { my $name = shift; # Name of package "{'testing'} && !$bi->{'lenny-ignore'}); + return ($bi->{$dist} && !$bi->{$bugcfg::debian_releases->{$dist}.'-ignore'}); } +sub check_worry_testing { + return check_worry($_[0],'testing'); +} sub check_worry_stable { - my ($bi) = @_; - - return ($bi->{'stable'} && !$bi->{'etch-ignore'}); + return check_worry($_[0],'stable'); +} +sub check_worry_oldstable { + return check_worry($_[0],'oldstable'); } sub check_worry_unstable { @@ -346,7 +363,7 @@ sub get_taginfo { $taginfo .= $bi->{'unreproducible'} ? "R" : " "; $taginfo .= $bi->{'security'} ? "S" : " "; $taginfo .= $bi->{'upstream'} ? "U" : " "; - $taginfo .= ($bi->{'etch-ignore'} || $bi->{'lenny-ignore'}) ? "I" : " "; + $taginfo .= ($bi->{$bugcfg::debian_releases->{stable}.'-ignore'} || $bi->{$bugcfg::debian_releases->{testing}.'-ignore'}) ? "I" : " "; return $taginfo; } @@ -355,7 +372,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}; }