X-Git-Url: https://git.donarmstrong.com/?p=bugscan.git;a=blobdiff_plain;f=scanlib.pm;h=65adb6312e18fff97c260f87f311071e49436452;hp=dc4aac662351f0b5826a4ed2075d24c45906e418;hb=4ef8564c7e87c67015de727dbf9bd23a51f927d3;hpb=4e592687c1e5ade0ccc59f80f6fa2a8d814f7859 diff --git a/scanlib.pm b/scanlib.pm index dc4aac6..65adb63 100644 --- a/scanlib.pm +++ b/scanlib.pm @@ -6,13 +6,11 @@ # which was based on an unknown other script. # # Global variables: -# %comments - map from bugnumber to bug description # %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; @@ -26,43 +24,7 @@ use warnings; require bugcfg; package scanlib; -our (%comments,%premature,%exclude,%maintainer,%section,%packagelist,%NMU,%debbugssection,%bugs); - -sub readcomments() { -# Read bug commentary -# It is in paragraph format, with the first line of each paragraph being -# the bug number or package name to which the comment applies. -# Prefix a bug number with a * to force it to be listed even if it's closed. -# (This deals with prematurely closed bugs) - - my $index; # Bug-number for current comment - my $file; # Name of comments-file - - %comments = (); # Initialize our data - %premature = (); - %exclude = (); - $file=shift; - open(C, $file) or die "open $file: $!\n"; - while () { - chomp; - if (m/^\s*$/) { # Check for paragraph-breaks - undef $index; - } elsif (defined $index) { - $comments{$index} .= $_ . "\n"; - } else { - if (s/^\*//) { # Test & remove initial * - $premature{$_} = 1; - } - if (s/\s+EXCLUDE\s*//) { # Test & remove EXCLUDE - $exclude{$_} = 1; - next; - } - $index = $_; - $comments{$index} = ''; # New comment, initialize data - } - } - close(C); -} +our (%premature,%exclude,%maintainer,%section,%packagelist,%debbugssection,%bugs); # Read the list of maintainer @@ -215,6 +177,13 @@ sub scanspooldir() { $disttags{'testing'} = grep(/^etch$/, @tags); $disttags{'unstable'} = grep(/^sid$/, @tags); $disttags{'experimental'} = grep(/^experimental$/, @tags); + + # default according to dondelelcaro 2006-11-11 + if (!$disttags{'oldstable'} && !$disttags{'stable'} && !$disttags{'testing'} && !$disttags{'unstable'} && !$disttags{'experimental'}) { + $disttags{'testing'} = 1; + $disttags{'unstable'} = 1; + $disttags{'experimental'} = 1; + } my $relinfo = ""; if (defined($section{$bug->{'package'}}) && $section{$bug->{'package'}} eq 'pseudo') { @@ -223,25 +192,31 @@ sub scanspooldir() { for my $dist qw(oldstable stable testing unstable experimental) { $relinfo .= uc(substr($dist, 0, 1)) if $disttags{$dist}; } + next if (length($bug->{'done'})); } else { - # default according to dondelelcaro 2006-11-11 - if (!$disttags{'oldstable'} && !$disttags{'stable'} && !$disttags{'testing'} && !$disttags{'unstable'} && !$disttags{'experimental'}) { - $disttags{'testing'} = 1; - $disttags{'unstable'} = 1; - $disttags{'experimental'} = 1; - } - # 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 {}; next if (!$disttags{$dist}); + # This is needed for now + my $exists = 0; + for my $arch (@bugcfg::architectures) { + for my $pkg (split /[,\s]+/, $bug->{'package'}) { + my @versions = Debbugs::Packages::getversions($pkg, $dist, $arch); + $exists = 1 if (scalar @versions > 0); + } + last if $exists; + } + + next if !$exists; + my $presence = Debbugs::Status::bug_presence( bug => $f, status => $bug, dist => $dist, - arch => [ qw(alpha amd64 arm hppa i386 ia64 mips mipsel powerpc s390 sparc) ] + arch => \@bugcfg::architectures ); # ignore bugs that are absent/fixed in this distribution, include everything @@ -324,39 +299,6 @@ sub readstatus() { } -sub readNMUstatus() { - my $bug; # Number of current bug - my $source; # Source upload which closes this bug. - my $version; # Version where this bug was closed. - my $flag; # Whether this paragraph has been processed. - my ($field, $value); - - for (split /\n/, LWP::UserAgent->new->request(HTTP::Request->new(GET => shift))->content) { - chomp; - if (m/^$/) { - $NMU{$bug} = 1; - $NMU{$bug, "source"} = $source; - $NMU{$bug, "version"} = $version; -# $comments{$bug} .= "[FIXED] Fixed package $source is in Incoming\n"; - $flag = 0; - } else { - ($field, $value) = split(/: /, $_, 2); - $bug = $value if($field =~ /bug/i); - $source = $value if($field =~ /source/i); - $version = $value if($field =~ /version/i); - $flag = 1; - } - } - if ($flag) { - $NMU{$bug} = 1; - $NMU{$bug, "source"} = $source; - $NMU{$bug, "version"} = $version; -# $comments{$bug} .= "[FIXED] Fixed package $source in in Incoming\n"; - } - close P; -} - - sub urlsanit { my $url = shift; $url =~ s/%/%25/g; @@ -375,12 +317,9 @@ sub htmlsanit { sub wwwnumber() { my $number = shift; # Number of bug to html-ize -# my $section); # Section for the bug "' . htmlsanit($number) . ''; -# ($section=$number) =~ s/([0-9]{2}).*/$1/; -# "$number"; } sub wwwname() { @@ -388,7 +327,6 @@ sub wwwname() { "' . htmlsanit($name) . ''; -# "$name"; } sub check_worry {