checkdescriptions.pl

[Ian Jackson]

Here's the script I use to check the presence and format of packages'
extended descriptions.

Would anyone like to take over maintaining it, running it, and
reporting bad or missing descriptions as bugs ?

Ian.

#!/usr/bin/perl --

$/="";
while (<>) {
    next if m/^Status:/ && !m/^Status:.* installed$/mi;
    m/^Package:\s*(\S+)\s*$/mi || die "no package name >$_<";
    $lpname= $pname= $1; $lpname =~ y/A-Z/a-z/;
    m/^Maintainer:\s*(\S.*\S)\s*$/mi || die "no maintainer >$_<";
    $maint= $1;
    $bad='';
    if (m/^Description:.*\n(?![ \t])/mi) {
        $bad= 'No extended description'; $badn=6;
    } elsif (m/^Description:.*\n(\t| [ \t])/mi) {
        $bad= 'Start of extended description is indented'; $badn=4;
    } elsif (m/^Description:.*\n .*\t/mi) {
        $bad= 'Extended description contains tabs'; $badn=5;
    } elsif (m/^Description:.*(\n .*)*\n[ \t]+\n/mi) {
        $bad= 'Extended description contains whitespace-only lines - very bad'; 
$badn=2;
    } elsif (m/^Description:.*\n \.?\n/mi) {
        $bad= 'Extended description starts with empty line'; $badn=3;
    } elsif (m/^Description:.*(\n .*)*\n.*\S  +\S.*\S  +\S/mi) {
        $bad= 'Extended description appears to be right-justified'; $badn=5;
    } elsif (m/^Description:\s*(\S+)/mi && (($w1=$1) =~ y/A-Z/a-z/, $w1 eq 
$lpname)) {
        $bad= 'Summary description starts with package name'; $badn=5;
    } elsif (m/^Description:.*\n \S/mi) {
        $bad= 'Extended description provided and looks good'; $badn=0;
    } elsif (!m/^Description:/mi) {
        $bad= 'No description at all'; $badn=3;
    } else {
        die ">$_<";
        $bad= "Urgle $pname"; $badn=-1;
    }
    $v='';
    if (m/^Version:\s*(\S+)$/mi) {
        $v= " (".$1;
        if (m/^(?:Package-)?Revision:\s*(\S+)$/mi) { $v .= "-$1"; }
        $v.= ")";
    }
    $this= sprintf("%-40s %-35.35s",$pname.$v,$maint);
    $badness{$this}= $bad;
    $badindex{$badn,$bad}= $bad;
}

print "Summary of number of packages in each category:\n";
for $k (sort keys %badindex) {
    $count= 0;
    for $p (sort keys %badness) {
        next if $badness{$p} ne $badindex{$k};
        $count++;
    }
    printf "%6d %s\n",$count,$badindex{$k};
    $count{$k}= 
}

for $k (sort {
    $count{$a} != $count{$b} ? $count{$a} <=> $count{$b} : $a cmp $b
    } (keys %badindex)) {
    print "\n$badindex{$k}:\n";
    for $p (sort keys %badness) {
        next if $badness{$p} ne $badindex{$k};
        print " $p\n";
    }
}