X-Git-Url: https://git.donarmstrong.com/?p=bugscan.git;a=blobdiff_plain;f=scanlib.pm;h=4c768720089f23de08023d1f75a690fae09730c9;hp=a9c51964a91c3abdb9b6c9a1c03241124a6fc3be;hb=02cc5bba35cc8b9c6ce76a2c1bc7b520187bcaa3;hpb=f75e34fa9be4f762c2b3844622a753237bc89365 diff --git a/scanlib.pm b/scanlib.pm index a9c5196..4c76872 100644 --- a/scanlib.pm +++ b/scanlib.pm @@ -1,5 +1,5 @@ #! /usr/bin/perl -# vim: ts=4 sw=4 nowrap +# vim: ts=8 sw=8 nowrap # # General functions for scanning the BTS-database. # Based on bugscan, written by Richard Braakman , @@ -154,6 +154,12 @@ sub scanspooldir() { 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'}; @@ -181,7 +187,6 @@ sub scanspooldir() { $disttags{'experimental'} = 1; } - my $bi = {}; if (defined($section{$bug->{'package'}}) && $section{$bug->{'package'}} eq 'pseudo') { # versioning information makes no sense for pseudo packages, # just use the tags @@ -219,8 +224,8 @@ sub scanspooldir() { next if !$affects_any; } - for my $keyword qw(pending patch help moreinfo unreproducible security upstream etch-ignore) { - $bi->{$keyword} = ($bug->{'keywords'} =~ /\b$keyword\b/) ? 1 : 0; + for my $keyword qw(pending patch help moreinfo unreproducible security upstream etch-ignore lenny-ignore) { + $bi->{$keyword} = grep(/^$keyword$/, @tags); } if (length($bug->{'mergedwith'})) { @@ -236,35 +241,45 @@ sub scanspooldir() { 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 + my $filename = shift; + open STATUS, "<", $filename + or die "$filename: $!"; + + while (1) { + chomp (my $type = ); + if ($type eq 'package') { + chomp (my $package = ); + chomp (my $section = ); + chomp (my $maintainer = ); + my $blank = ; + + $section{$package} = $section; + $maintainer{$package} = $maintainer; + } + if ($type eq 'bug') { + my $bug = {}; + while (1) { + my $line = ; + last if ($line !~ /^(.*?)=(.*)$/); - $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; + $bug->{$1} = $2; + } + $bugs{$bug->{'number'}} = $bug; + + for my $package (split /[,\s]+/, $bug->{'package'}) { + $_= $package; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9]/; + push @{$packagelist{$_}}, $bug->{'number'}; + } } + last if ($type eq 'end'); } - close P; + close(STATUS); } @@ -299,22 +314,15 @@ sub wwwname() { } sub check_worry { - my ($status) = @_; + my ($bi) = @_; - if ($status =~ m/^\[[^]]*I/ or - $status !~ m/ \[[^]]*T/) { - return 0; - } - return 1; + return ($bi->{'testing'} && !$bi->{'lenny-ignore'}); } sub check_worry_stable { - my ($status) = @_; + my ($bi) = @_; - if ($status !~ m/ \[[^]]*S/) { - return 0; - } - return 1; + return ($bi->{'stable'} && !$bi->{'etch-ignore'}); } sub get_taginfo { @@ -328,7 +336,7 @@ sub get_taginfo { $taginfo .= $bi->{'unreproducible'} ? "R" : " "; $taginfo .= $bi->{'security'} ? "S" : " "; $taginfo .= $bi->{'upstream'} ? "U" : " "; - $taginfo .= $bi->{'etch-ignore'} ? "I" : " "; + $taginfo .= ($bi->{'etch-ignore'} || $bi->{'lenny-ignore'}) ? "I" : " "; return $taginfo; }