]> git.donarmstrong.com Git - bugscan.git/blobdiff - scanlib.pm
Small simplification.
[bugscan.git] / scanlib.pm
index a9c51964a91c3abdb9b6c9a1c03241124a6fc3be..0f64165b5a0ab7b649867e1fcc6e5fd1a14e534e 100644 (file)
@@ -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 <dark@debian.org>,
@@ -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 sarge-ignore etch-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 = <STATUS>);
+               if ($type eq 'package') {
+                       chomp (my $package = <STATUS>);
+                       chomp (my $section = <STATUS>);
+                       chomp (my $maintainer = <STATUS>);
+                       my $blank = <STATUS>;
+
+                       $section{$package} = $section;
+                       $maintainer{$package} = $maintainer;
+               }
+               if ($type eq 'bug') {
+                       my $bug = {};
+                       while (1) {
+                               my $line = <STATUS>;
+                               last if ($line !~ /^(.*?)=(.*)$/);
 
-       $file=shift;
-       open(P, $file) or die "open $file: $!";
-       while (<P>) {
-               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->{'etch-ignore'});
 }
 
 sub check_worry_stable {
-       my ($status) = @_;
+       my ($bi) = @_;
 
-       if ($status !~ m/ \[[^]]*S/) {
-               return 0;
-       }
-       return 1;
+       return ($bi->{'stable'} && !$bi->{'sarge-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->{'sarge-ignore'} || $bi->{'etch-ignore'}) ? "I" : " ";
 
        return $taginfo;
 }