X-Git-Url: https://git.donarmstrong.com/?p=bugscan.git;a=blobdiff_plain;f=scanlib.pm;h=3dca704000de24c6dfc17caa78410b7cde07edaf;hp=37931f7f0358e89ab49ca72b1f4a7e58158367b6;hb=817d5389c87ae35e3dabbcc689d1fd77a339daa2;hpb=79a7d8380b9712a363a95e8998d6ba3e95ff581b;ds=sidebyside diff --git a/scanlib.pm b/scanlib.pm index 37931f7..3dca704 100644 --- a/scanlib.pm +++ b/scanlib.pm @@ -6,12 +6,9 @@ # which was based on an unknown other script. # # Global variables: -# %premature - list of prematurely closed bugreports -# %exclude - list of bugreports to exclude from the report # %maintainer - map from packagename to maintainer # %section - map from packagename to section in the FTP-site # %packagelist - map from packagename to bugreports -# %NMU - map with NMU information use lib qw(/org/bugs.debian.org/perl); use LWP::UserAgent; @@ -25,7 +22,7 @@ use warnings; require bugcfg; package scanlib; -our (%premature,%exclude,%maintainer,%section,%packagelist,%NMU,%debbugssection,%bugs); +our (%maintainer,%section,%packagelist,%debbugssection,%bugs); # Read the list of maintainer @@ -154,11 +151,15 @@ sub scanspooldir() { closedir(DIR); for $f (@list) { - next if $exclude{$f}; # Check the list of bugs to skip - my $bug = Debbugs::Status::read_bug(summary => "$f.summary"); next if (!defined($bug)); + my $bi = { + number => $f, + subject => $bug->{'subject'}, + package => $bug->{'package'} + }; + $skip=1; for $walk (@bugcfg::priorities) { $skip=0 if $walk eq $bug->{'severity'}; @@ -186,19 +187,21 @@ sub scanspooldir() { $disttags{'experimental'} = 1; } - my $relinfo = ""; 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) { - $relinfo .= uc(substr($dist, 0, 1)) if $disttags{$dist}; + $bi->{$dist} = $disttags{$dist}; } next if (length($bug->{'done'})); } else { + 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) { local $SIG{__WARN__} = sub {}; + $bi->{$dist} = 0; next if (!$disttags{$dist}); my $presence = Debbugs::Status::bug_presence( @@ -213,24 +216,17 @@ sub scanspooldir() { # indicates that no versioning information is present and it's not closed # unversioned) if (!defined($presence) || ($presence ne 'absent' && $presence ne 'fixed')) { - $relinfo .= uc(substr($dist, 0, 1)); + $bi->{$dist} = 1; + $affects_any = 1; } } - next if $relinfo eq '' and not $premature{$f}; - $premature{$f}++ if $relinfo eq ''; + next if !$affects_any; } - $taginfo = "["; - $taginfo .= ($bug->{'keywords'} =~ /\bpending\b/ ? "P" : " "); - $taginfo .= ($bug->{'keywords'} =~ /\bpatch\b/ ? "+" : " "); - $taginfo .= ($bug->{'keywords'} =~ /\bhelp\b/ ? "H" : " "); - $taginfo .= ($bug->{'keywords'} =~ /\bmoreinfo\b/ ? "M" : " "); - $taginfo .= ($bug->{'keywords'} =~ /\bunreproducible\b/ ? "R" : " "); - $taginfo .= ($bug->{'keywords'} =~ /\bsecurity\b/ ? "S" : " "); - $taginfo .= ($bug->{'keywords'} =~ /\bupstream\b/ ? "U" : " "); - $taginfo .= ($bug->{'keywords'} =~ /\betch-ignore\b/ ? "I" : " "); - $taginfo .= "]"; + for my $keyword qw(pending patch help moreinfo unreproducible security upstream sarge-ignore etch-ignore) { + $bi->{$keyword} = ($bug->{'keywords'} =~ /\b$keyword\b/) ? 1 : 0; + } if (length($bug->{'mergedwith'})) { my @merged = split(' ', $bug->{'mergedwith'}); @@ -239,83 +235,51 @@ sub scanspooldir() { for my $package (split /[,\s]+/, $bug->{'package'}) { $_= $package; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9]/; - if (not defined $section{$_}) { - if (defined $debbugssection{$_}) { - $relinfo .= "X"; - } else { - next; # Skip unavailable packages - } - } - push @{$packagelist{$_}}, $f; } - if ($relinfo eq "") { # or $relinfo eq "U" # confuses e.g. #210306 - $relinfo = ""; - } else { - $relinfo = " [$relinfo]"; - } + my $taginfo = get_taginfo($bi); + my $relinfo = get_relinfo($bi); - $bugs{$f} = "$f $taginfo$relinfo " . $bug->{'subject'}; + $bugs{$f} = $bi; } } sub readstatus() { - my $bug; # Number of current bug - my $subject; # Subject for current bug - my $pkg; # Name of current package - my $file; # Name of statusfile - my $sect; # Section of current package - my $mnt; # Maintainer of current package - - $file=shift; - open(P, $file) or die "open $file: $!"; - while (
) {
- chomp;
- if (m/^[0-9]+ \[/) {
- ($bug,$subject)=split(/ /, $_, 2);
- $bugs{$bug}=$subject;
- push @{$packagelist{$pkg}}, $bug;
- } else {
- ($pkg,$sect, $mnt)=split(/ /, $_, 3);
- next if (!defined($pkg));
- $section{$pkg}=$sect;
- $maintainer{$pkg}=$mnt;
+ my $filename = shift;
+ open STATUS, "<", $filename
+ or die "$filename: $!";
+
+ while (1) {
+ chomp (my $type =