http://qs1969.pair.com?node_id=360096
Category: Miscellaneous
Author/Contact Info /msg LTjake
Description:

I was interested in some basic stats on how my CPAN testing client was doing. This little script will check the latest X posts (defaults to 50) to the perl.cpan.testers newsgroups for a particular author and display how many PASS/FAIL/UNKNOWN reports they have submitted.

a "screenshot":

C:\>perl tester-stats.pl cpansmoke@alternation.net Processing latest 50 items out of 142716 142716...Found 2 reports PASS: 002
use Net::NNTP;

use strict;
#use warnings;
#use diagnostics;

# connection constants
use constant SERVER => 'nntp.perl.org';
use constant GROUP  => 'perl.cpan.testers';

# group array constants
use constant TOTAL  => 0;
use constant FIRST  => 1;
use constant LAST   => 2;

my $email  = shift or die 'No email (author) specified';
my $server = Net::NNTP->new( SERVER ) or die 'Cannot connect to server
+ ' . SERVER;
my @group  = $server->group( GROUP );
my $items  = shift || 50;
$items     = $group[ TOTAL ] if $items > $group[ TOTAL ];
my $start  = $group[ LAST ] - $items + 1;
my $count  = 0;
my %stats;

$|++;

printf "Processing latest %d items out of %d\n\n", $items, $group[ TOT
+AL ];

for my $id ( $start..$group[ LAST ] ) {
    print "\r$id...";

    # The "From" header must match the email address
    my $header = $server->head( $id );
    next unless grep { /^From:.+\Q$email\E/ } @$header;

    # Parse the subject for PASS, FAIL, etc
    my $subject = ( grep { /^Subject:/ } @$header )[ 0 ];
    next if $subject =~ /CPAN Upload/;
    if( $subject =~ /^Subject: ([A-Z]+) / ) {
        $stats{ $1 }++;
        $count++;
    }
}

$server->quit;

printf "Found %d reports\n\n", $count;
for my $type ( sort keys %stats ) {
    printf "%7s: %03d\n", $type, $stats{ $type };
}
Replies are listed 'Best First'.
Re: Basic CPAN tester stats
by barbie (Deacon) on Sep 13, 2004 at 13:55 UTC
    Nice. I had to do something similar when I got all the stats for 2003 for my talk Striving For Perfection to Birmingham.pm. Unfortunately my script took bloomin' ages, due it getting 12 months worth of stats ... over 31,000 test reports!

    --
    Barbie | Birmingham Perl Mongers user group | http://birmingham.pm.org/