scripts/summary.in

   1 #!/usr/bin/perl
   2
   3 require('/etc/debbugs/config');
   4 require('/usr/lib/debbugs/errorlib');
   5 chdir("$gSpoolDir") || die "chdir spool: $!\n";
   6
   7 #open(DEBUG,">&4");
   8
   9 $mode= shift(@ARGV);
  10
  11 open(M,"$gMaintainerFile") || &quit("open $gMaintainerFile: $!");
  12 while (<M>) {
  13     m/^(\S+)\s+(\S.*\S)\s*$/ || warn "$_ ?";
  14     ($a,$b)=($1,$2);
  15     $a =~ y/A-Z/a-z/;
  16     $maintainer{$a}= $b;
  17 }
  18 close(M);
  19
  20 defined($startdate= time) || &quit("failed to get time: $!");
  21
  22 opendir(DIR,"db") || &quit("opendir db: $!\n");
  23 @list= grep(m/^\d+\.status$/,readdir(DIR));
  24 grep(s/\.status$//,@list);
  25 @list= sort { $a <=> $b } @list;
  26
  27 $head= $mode eq 'bymaint'
  28     ? ' Package     Ref    Subject'
  29     : ' Ref   Package    Keywords/Subject               Package maintainer';
  30 $amonths=-1;
  31
  32 while (length($f=shift(@list))) {
  33     &filelock("lock/$f");
  34     if (!open(S,"db/$f.status")) { &unlinklock; next; }
  35     chop($s_originator= <S>);
  36     chop($s_date= <S>);
  37     chop($s_subject= <S>);
  38     chop($s_msgid= <S>);
  39     chop($s_package= <S>);
  40     chop($s_keywords= <S>);
  41     chop($s_done= <S>);
  42     chop($s_forwarded= <S>);
  43     $_= $s_package; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9]/;
  44     $s_maintainer=
  45         defined($maintainer{$_}) ? $maintainer{$_} :
  46         length($_) ? "(unknown -- \`$_')" :
  47         "(unknown)";
  48     if ($mode eq 'undone' || $mode eq 'veryold') {
  49         &unfilelock;
  50         next if length($s_done) || length($s_forwarded);
  51         $cmonths= int(($startdate - $s_date)/2592000); # 3600*24*30 (30 days)
  52         next if $mode eq 'veryold' && $cmonths < 2;
  53         if ($cmonths != $amonths) {
  54             $msg= $cmonths == 0 ? "Submitted in the last month" :
  55                   $cmonths == 1 ? "Over one month old" :
  56                   $cmonths == 2 ? "Over two months old - attention is required" :
  57                                   "OVER $cmonths MONTHS OLD - ATTENTION IS REQUIRED";
  58             print "\n$msg:\n$head\n";
  59             $amonths= $cmonths;
  60         }
  61         printf("%6d %-10.10s %-30.30s %-.31s\n", $f, $s_package,
  62                (length($s_keywords) ? $s_keywords.'/' : '').$s_subject,
  63                $s_maintainer) || &quit("output undone: $!");
  64     } elsif ($mode eq 'bymaint') {
  65         &unfilelock;
  66         next if length($s_done) || length($s_forwarded);
  67         $string{$f}=
  68             sprintf(" %-10.10s %6d  %-.59s\n", $s_package, $f, $s_subject);
  69         $s_maintainer= "(unknown)" if $s_maintainer =~ m/^\(unknown \-\-/;
  70         $maintainercnt{$s_maintainer}++;
  71         $maintainerlist{$s_maintainer}.= " $f";
  72     } else {
  73         &quit("badmode $mode");
  74     }
  75 }
  76
  77 if ($mode eq 'bymaint') {
  78     print("$head\n") || &quit("output head: $!");
  79     for $m (sort { $maintainercnt{$a} <=> $maintainercnt{$b} } keys %maintainercnt) {
  80         printf("\n%s (%d $gBugs):\n",$m,$maintainercnt{$m})
  81             || &quit("output mainthead: $!");
  82         for $i (sort { $string{$a} cmp $string{$b} } split(/ /,$maintainerlist{$m})) {
  83             printf($string{$i}) || &quit("output 1bymaint: $!");
  84         }
  85     }
  86 }
  87
  88 close(STDOUT) || &quit("close stdout: $!");