Rev 11 |
Rev 14 |
Go to most recent revision |
View as "text/plain" |
Blame |
Compare with Previous |
Last modification |
View Log
| RSS feed
1
#!/usr/bin/env perl
use strict
;
use warnings
;
use diagnostics
;
use utf8
;
use Encode
;
## Print out all text to STDOUT UTF-8 encoded
binmode STDOUT, ':encoding(UTF-8)';
############################
## newsstat.pl version 0.4.3
###########################################################################
## Collect statistics about a newsgroup (specified by first argument)
## in the local news spool. Check all articles in the last 30-day period.
## Rank posters by number of posts and by volume of posts, report on top
## and bottom 20 posters. Show their name, number of posts, size of posts,
## percentage of quoted lines. Rank user-agents used, by poster rather
## than by post. Rank top 20 threads. Rank top 10 cross-posted groups.
##
## Numbers and paths can be configured below. See ChangeLog and TODO
## for more. -- PE
###########################################################################
###################### USER CONFIGURATIONS ############################
## The name of the group to do stats for
my $newsgroup_name = $ARGV[0];
$newsgroup_name or &usage;
## Check for removal flags
my $ix;
my $j;
my %skipSec;
my @skiplist;
my $args = @ARGV;
for ( $ix = 1 ; $ix < $args ; $ix++ )
{
$j = $ix + 1;
if ( $ARGV[$ix] eq "-x" )
{
@skiplist = split( ",", $ARGV[$j] );
}
elsif ( $ARGV[$ix] =~ /-x(\d.*)/ )
{
@skiplist = split( ",", $1 );
}
}
foreach (@skiplist)
{
$skipSec{$_} = 1;
}
## Leafnode users will want /var/spool/news for this variable.
my $news = "/var/spool/news/";
## How many days are we doing statistics for?
my $numdays = 30;
## Number of agents we list
my $topagents = 10;
## Number of threads we want to know about
my $topthreads = 20;
## Number of top or bottom posters to show
my $topposters = 20;
## Number of cross-posted threads to show
my $topcrossposts = 10;
## Number of time zones to show
my $toptz = 10;
###################### DATA STRUCTURES ######################
my $group = $newsgroup_name;
$group =~ s!\
.!/!g
;
my %data; # name, count, agent, total, orig, quoted
my %threads; # subject, count
my %crossposts; # group, count
my %tz; # timezones by count
my %headers; # holds header of current article
my %lcheader; # holds lowercase headers
my @body; # holds body of current article
my @sig; # holds sig text;
my $totalposts; # total no. of posts considered
my $filename; # name of current article file
my $filesize; # size of current article file
my $earliest; # earliest article we have found
my $latest; # latest article we have found
my $poster; # poster we are dealing with
my $totsize = 0; # holds total sizes of all files
my $totheader = 0; # total size of header material
my $totbody = 0; # total size of body material
my $totsig = 0; # total size of sig material
my $totorig = 0; # total size of original material
my $totquoted = 0; # total size of quoted material
my $origposts = 0; # total no. of original posts
my $replies = 0; # total no. of replies
my $i; # general purpose
my %distinct_agent;
## Used to hold counts of User Agents used
my %agents = (
"Compuserver" => 0,
"Foorum" => 0,
"Forte Agent" => 0,
"Forte Free Agent" => 0,
"Gnus" => 0,
"KNode" => 0,
"MacSOUP" => 0,
"MT-NewsWatcher" => 0,
"MicroPlanet Gravity" => 0,
"Microsoft Outlook Express" => 0,
"Microsoft Windows Mail" => 0,
"Mozilla" => 0,
"News Rover" => 0,
"NN" => 0,
"Pan" => 0,
"rn" => 0,
"slrn" => 0,
"Sylpheed" => 0,
"tin" => 0,
"VSoup" => 0,
"WebTV" => 0,
"Xnews" => 0
);
######################## MAIN CODE ########################
$! = 1;
chdir("$news$group") or die "Can't cd to $news$group: $!\n";
opendir( DIR
, "." ) or die "Can't open $news$group directory: $!\n";
while ( defined( $filename = readdir(DIR
) ) )
{
%lcheader = ();
next unless -f
$filename; # only want real files
next if ( $filename eq ".overview" ); # real articles only
next if ( -M
$filename > $numdays ); # only want articles <= a certain age
$earliest = ( stat $filename )[9] unless defined($earliest);
$latest = ( stat $filename )[9] unless defined($latest);
&get_article($filename); # read in the article
&get_data; # grab the data from the article
$totalposts++; # bump count of articles considered
}
closedir(DIR
); # finished with the directory
## Post-processing
&count_agents; # count agents, collapsing versions
&fix_percent; # check percentages orig/total for posters
&write_data;
#################### DISPLAY RESULTS #####################
print "=" x
76, "\n";
printf "%s\n", ¢red( "Analysis of posts to $newsgroup_name", 76 );
print "=" x
76, "\n";
printf "%s\n",
¢red( "(stats compiled with a script by Garry Knight et al.)", 76 );
print "\n\n";
printf "Total posts considered: %s over %d days\n", commify
($totalposts),
$numdays;
printf "Earliest article: %s\n", scalar localtime($earliest);
printf "Latest article: %s\n", scalar localtime($latest);
printf "Original articles: %s, replies: %s\n", commify
($origposts),
commify
($replies);
printf "Total size of posts: %s bytes (%s KiB) (%.2f MiB)\n", commify
($totsize),
commify
( int( $totsize / 1024 ) ), $totsize / 1048576; #
printf "Average %s articles per day, %.2f MiB per day, %s bytes per article\n",
commify
( int( $totalposts / $numdays ) ), $totsize / $numdays / 1048576,
commify
( int( $totsize / $totalposts ) );
my $count = keys %data;
printf "Total headers: %s KiB bodies: %s KiB\n",
commify
( int( $totheader / 1024 ) ), commify( int( $totbody / 1024 ) );
printf "Body text - quoted: %s KiB, original: %s KiB = %02.2f%%, sigs: %s KiB\n",
commify
( int( $totquoted / 1024 ) ), commify( int( $totorig / 1024 ) ),
( $totorig * 100 ) / ( $totorig + $totquoted ),
commify
( int( $totsig / 1024 ) );
printf "Total number of posters: %s, average %s bytes per poster\n",
commify
($count), commify
( int( $totsize / $count ) ); #/
$count = keys %threads;
printf "Total number of threads: %s, average %s bytes per thread\n",
commify
($count), commify
( int( $totsize / $count ) ); #/
printf "Total number of user agents: %d\n", scalar keys %agents;
print "\n", "=" x
76, "\n";
########################################
## Show posters by article count Sec 1;
########################################
unless ( $skipSec{1} )
{
if ( keys %data < $topposters )
{
$count = keys %data;
}
else
{
$count = $topposters;
}
printf "%s\n", ¢red( "Top $count posters by number of articles", 76 );
print "=" x
76, "\n";
$i = 0;
foreach
my $poster ( sort { $data{$b}{count
} <=> $data{$a}{count
} } keys %data )
{
my $name = substr( $poster, 0, 65 );
printf "%2d: %-63s : %6d\n", $i + 1, rpad
( $poster, 63, "." ),
$data{$poster}{count
};
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
######################################
## Show posters by size in KiB Sec 2;
######################################
unless ( $skipSec{2} )
{
if ( keys %data < $topposters )
{
$count = keys %data;
}
else
{
$count = $topposters;
}
printf "%s\n", ¢red( "Top $count posters by article size in KiB", 76 );
print "=" x
76, "\n";
$i = 0;
foreach my $poster ( sort { $data{$b}{size
} <=> $data{$a}{size
} } keys %data )
{
my $name = substr( $poster, 0, 62 );
printf "%2d: %-63s : %6d\n", $i + 1, rpad
( $poster, 63, "." ),
$data{$poster}{size
} / 1024; #/
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
#####################################
## Show top posters for original text
#####################################
unless ( $skipSec{3} )
{
if ( keys %data < $topposters )
{
$count = keys %data;
}
else
{
$count = $topposters;
}
printf "%s\n",
¢red( "Top $count responders by original text (> 5 posts)", 76 );
print "=" x
76, "\n";
$i = 0;
foreach my $poster (
sort { $data{$b}{percent
} <=> $data{$a}{percent
} }
keys %data
)
{
next if $data{$poster}{quoted
} == 0;
next if $data{$poster}{count
} < 5;
my $name = substr( $poster, 0, 63 );
printf "%2d: %-63s : %02.2f%%\n", $i + 1, rpad
( $poster, 63, "." ),
$data{$poster}{percent
};
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
########################################
## Show bottom posters for original text
########################################
unless ( $skipSec{4} )
{
if ( keys %data < $topposters )
{
$count = keys %data;
}
else
{
$count = $topposters;
}
printf "%s\n",
¢red( "Bottom $count responders by original text (> 5 posts)", 76 );
print "=" x
76, "\n";
$i = 0;
foreach my $poster (
sort { $data{$a}{percent
} <=> $data{$b}{percent
} }
keys %data
)
{
next if $data{$poster}{quoted
} == 0;
next if $data{$poster}{count
} < 5;
my $name = substr( $poster, 0, 63 );
printf "%2d: %-63s : %02.2f%%\n", $i + 1, rpad
( $poster, 63, "." ),
$data{$poster}{percent
};
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
#####################################
## Show threads by number of articles
#####################################
unless ( $skipSec{5} )
{
if ( keys %threads < $topthreads )
{
$count = keys %threads;
}
else
{
$count = $topthreads;
}
printf "%s\n", ¢red( "Top $count threads by no. of articles", 76 );
print "=" x
76, "\n";
$i = 0;
foreach my $thread (
sort { $threads{$b}{count
} <=> $threads{$a}{count
} }
keys %threads
)
{
my $name = substr( $thread, 0, 65 );
printf "%2d: %-63s : %6d\n", $i + 1, rpad
( $name, 63, "." ),
$threads{$thread}{count
};
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
##############################
## Show threads by size in KiB
##############################
unless ( $skipSec{6} )
{
if ( keys %threads < $topthreads )
{
$count = keys %threads;
}
else
{
$count = $topthreads;
}
printf "%s\n", ¢red( "Top $count threads by size in KiB", 76 );
print "=" x
76, "\n";
$i = 0;
foreach my $thread (
sort { $threads{$b}{size
} <=> $threads{$a}{size
} }
keys %threads
)
{
my $name = substr( $thread, 0, 65 );
printf "%2d: %-63s : %6d\n", $i + 1, rpad
( $name, 63, "." ),
$threads{$thread}{size
} / 1024; #/
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
##################################
## Show top 10 cross-posted groups
##################################
unless ( $skipSec{7} )
{
delete $crossposts{"$newsgroup_name"}; # don't include ours
if ( keys %crossposts < $topcrossposts )
{
$count = keys %crossposts;
}
else
{
$count = $topcrossposts;
}
printf "%s\n", ¢red( "Top $count cross-posted groups", 76 );
print "=" x
76, "\n";
$i = 0;
foreach
my $name ( sort { $crossposts{$b} <=> $crossposts{$a} } keys %crossposts )
{
printf "%2d: %-63s : %6d\n", $i + 1, rpad
( $name, 63, "." ),
$crossposts{$name};
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
#########################
## Show agents and counts
#########################
unless ( $skipSec{8} )
{
if ( keys %agents < $topagents )
{
$count = keys %agents;
}
else
{
$count = $topagents;
}
printf "%s\n", ¢red( "Top $count User Agents by poster", 76 );
print "=" x
76, "\n";
$i = 0;
foreach my $agent ( sort { $agents{$b} <=> $agents{$a} } keys %agents )
{
printf "%2d: %-63s : %6d\n", $i + 1, rpad
( $agent, 63, "." ),
$agents{$agent};
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
#######################
## Show distinct agents
#######################
unless ( $skipSec{9} )
{
if ( keys %distinct_agent < $topagents )
{
$count = keys %distinct_agent;
}
else
{
$count = $topagents;
}
printf "%s\n", ¢red( "Top $count User Agents by number of posts", 76 );
print "=" x
76, "\n";
$i = 0;
foreach my $agent (
sort { $distinct_agent{$b} <=> $distinct_agent{$a} }
keys %distinct_agent
)
{
printf "%2d: %-58s : %5d (%2.f%%)\n", $i + 1, rpad
( $agent, 58, "." ),
$distinct_agent{$agent},
( ( $distinct_agent{$agent} / $totalposts ) * 100 );
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
############################
## Show timezones and counts
############################
unless ( $skipSec{10} )
{
if ( keys %tz < $toptz )
{
$count = keys %tz;
}
else
{
$count = $toptz;
}
printf "%s\n", ¢red( "Top 10 time zones", 76 );
print "=" x
76, "\n";
$i = 0;
foreach my $zone ( sort { $tz{$b} <=> $tz{$a} } keys %tz )
{
printf "%2d: %-63s : %6d\n", $i + 1, rpad
( $zone, 63, "." ), $tz{$zone};
last if ( ++$i == $count );
}
print "\n", "=" x
76, "\n";
}
################################ SUBROUTINES ################################
########################################
## Get current article's header and body
########################################
sub get_article
{
%headers = (); # dump old headers
my $filename = shift; # get the name of the file
## get stats about the file itself
$filesize = -s $filename; # get total size of file
$totsize += $filesize; # bump total sizes of all files
my $mtime = ( stat $filename )[9];
if ( $mtime < $earliest )
{
$earliest = $mtime;
}
elsif ( $mtime > $latest )
{
$latest = $mtime;
}
## now read the file
open( my $FILE, '<', $filename ) or die "Can't open $filename: $!\n";
while (<$FILE>)
{
$totheader += length($_); # bump total header size
last if (/^\s*$/); # end of header?
if (/^([^:\s]*):\s*(.*)/)
{
my ( $key, $val ) = ( $1, $2 );
$headers{$key} = decode
( 'MIME-Header', $val );
$lcheader{ clean
( lc($key) ) } = clean
($val);
}
}
@body = <$FILE>; # slurp up body
close($FILE);
} # get_article
####################################
## Get data from the current article
####################################
sub get_data
{
#### First, analyse header fields ####
## Set up this poster if not defined, get counts, sizes
my $poster = $headers{From
}; # get the poster's name
# Convert old to new format
$poster =~ s/^\s*(.+?\@.+?)\s*\((.+?)\)\s*$/$2 <$1>/;
# Collapse whitespace
$poster =~ s/\s+/ /;
# Remove outer quotes
$poster =~ s/^["'](.+?)["']\s+(.*)/$1 $2/;
if ( !defined( $data{$poster} ) )
{ # seen this one before?
$data{$poster}{agent
} = 'Unknown'; # comes after For: field
$data{$poster}{orig
} = 0;
$data{$poster}{quoted
} = 0;
}
$data{$poster}{count
}++; # bump count for this poster
$data{$poster}{size
} += $filesize; # total size of file
## The User-Agent and/or X-Newsreader fields
## for User-Agent by poster
if ( defined $lcheader{"user-agent"} )
{
$data{$poster}{agent
} = $lcheader{"user-agent"};
}
if ( defined $lcheader{"x-newsreader"} )
{
$data{$poster}{agent
} = $lcheader{"x-newsreader"};
}
## The User Agent for User-Agent by number of posts
my $UA = "unknown";
foreach my $keys ( keys %lcheader )
{
if ( defined $lcheader{'user-agent'} )
{
$UA = $lcheader{'user-agent'};
}
elsif ( defined $lcheader{"x-newsreader"} )
{
$UA = $lcheader{"x-newsreader"};
}
elsif ( defined $lcheader{'x-mailer'} )
{
$UA = $lcheader{'x-mailer'};
}
elsif (
( defined $lcheader{'organization'} )
&& ( $lcheader{'organization'} =~
/groups\.google|AOL|Supernews|WebTV|compuserve/ )
)
{
$UA = $lcheader{'organization'};
}
elsif ( $lcheader{'message-id'} =~ /pine/i )
{
$UA = "Pine";
} ## Hopefully found UA, else set to unknown
}
$UA = clean
($UA);
$UA = get_agent
($UA);
sub get_agent
{
my $raw = shift;
my $agent = $raw;
## strip http
if ( $raw =~ /.*http.*/ )
{
$raw =~ s!posted via
!!i
;
$raw =~ s!http
://!!g
;
$raw =~ s!/!!g
;
$raw =~ s! !!g
;
}
## Fix Outlook from Mac
if ( $raw =~ /^microsoft/i ) { $raw =~ s/-/ /g; }
## Pick out the popular agents
if (
$raw =~ /(outlook express)/i
|| $raw =~ /(windows mail)/i
|| $raw =~ /(microplanet gravity)/i
|| $raw =~ /(news rover)/i
|| $raw =~ /(forte agent)/i
|| $raw =~ /(forte free agent)/i
)
{
$agent = $1;
}
elsif (
$raw =~ /^(
pan
|sylpheed
|slrn
|mozilla
|knode
|tin
|hamster
|xrn
|xnews
|aol
|gnus
|krn
|macsoup
|messenger
|openxp
|pine
|thoth
|turnpike
|winvn
|vsoup
|google
|supernews
|nn
|rn
|007
|webtv
|compuserve
)/ix
)
{
$agent = $1;
}
else
{
## Clean up unknown agents
if ( $raw =~ m!^(.*?)/! )
{
$agent = $1;
}
elsif ( $raw =~ /^(\w*)\d.*/ )
{
$agent = $1;
}
}
$distinct_agent{$agent}++;
return $agent;
}
## Get all cross-posted newsgroups
for ( split /,/, $headers{"Newsgroups"} )
{
$crossposts{$_}++; # bump count for each
}
## Get threads
my $thread = $headers{"Subject"};
$thread =~ s/^re: //i; # Remove Re: or re: at start
$thread =~ s/\s+/ /g; # collapse whitespace
$threads{$thread}{count
} += 1; # bump count of this subject
$threads{$thread}{size
} += $filesize; # bump bytes for this thread
## Is this an original post or a reply?
if ( defined $headers{"References"} )
{
$replies++;
}
else
{
$origposts++;
}
## Get the time zone
$_ = $headers{"Date"};
my ($tz) = /\d\d:\d\d(?::\d\d)?\s+(.*)/;
if ( ( $tz =~ /UTC/ ) or ( $tz =~ /GMT/ ) or ( $tz =~ /0000/ ) )
{
$tz = "UTC";
}
$tz{$tz}++;
#### Now analyse the body text ####
my $insig = 0;
for (@body)
{
$totbody += length($_); # bump total body size
next if (/^$>/); # don't count blank lines in body
if ( $insig == 1 )
{
$totsig += length($_); # bump total sig size
## Bill Unruh uses ] quotes, and another poster uses ::
}
elsif ( /^\s*[>\]]/ or /^\s*::/ )
{ # are we in a quote line?
$data{$poster}{quoted
} += length($_); # bump count of quoted chrs
$totquoted += length($_);
}
elsif (/-- /)
{
$insig = 1;
}
else
{
## We must be processing an original line
$data{$poster}{orig
} += length($_); # bump count of original chrs
$totorig += length($_);
}
} # end for (@body)
} # get_data
#########################################
## Count the User-Agents used, collapsing
## different versions into one per agent.
#########################################
sub count_agents
{
POSTER
:
foreach my $poster ( keys %data )
{
foreach my $agent_name ( keys %distinct_agent )
{ # check against known ones
if ( $data{$poster}{agent
} =~ /\Q$agent_name\E/ )
{
$agents{$agent_name}++;
next POSTER
;
}
}
$agents{ $data{$poster}{agent
} }++;
}
} # count_agents
#############################################
## Set orig/total percentages for all posters
#############################################
sub fix_percent
{
foreach my $poster ( keys %data )
{
my $percent = 100;
if ( ( $data{$poster}{orig
} != 0 ) and ( $data{$poster}{quoted
} != 0 ) )
{
$percent =
$data{$poster}{orig
} * 100 /
( $data{$poster}{quoted
} + $data{$poster}{orig
} ); #/
}
elsif ( $data{$poster}{orig
} == 0 )
{
$percent = 0;
}
$data{$poster}{percent
} = $percent;
}
}
###############################
## Right pad a string with '.'s
###############################
sub rpad
{
## Get text to pad, length to pad, pad chr
my ( $text, $pad_len, $pad_chr ) = @_;
## DEBUG
#printf "|%s| = %d\n", $text, length($text);
if ( length($text) > $pad_len )
{
$text = substr( $text, 0, $pad_len );
}
my $padded = $text . $pad_chr x
( $pad_len - length($text) );
return $padded;
}
##################
## Centre a string
##################
sub centred
{
my ( $text, $width ) = @_; # text to centre, size of field to centre in
my $pad_len = ( $width - length($text) ) / 2; #/
my $centred = " " x
$pad_len . $text;
return $centred;
}
###########################
## Put commas into a number
###########################
sub commify
{
local $_ = shift;
1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
return $_;
}
################################################################
## Returns a string with leading and trailing whitespace removed
################################################################
sub clean
{
my $dirty = shift;
my $clean = $dirty;
$clean =~ s/^\s*|\s*$//g;
return $clean;
}
sub usage
{
print "usage: newstat.pl newsgroupname\n";
exit 1;
}
##################################
## Write data structures to a file
##################################
sub write_data
{
open my $OUTF, ">:encoding(UTF-8)", "/tmp/XDATA"
or die "Can't create XDATA: $!\n";
print $OUTF "Data collected from $newsgroup_name\n\n";
print $OUTF
"Poster Data\nname : agent : count : size: orig : quoted : per cent\n";
foreach my $name ( keys %data )
{
print $OUTF
"$name : $data{$name}{agent} : $data{$name}{count} : $data{$name}{size} : $data{$name}{orig} : $data{$name}{quoted} : $data{$name}{percent}\n";
}
print $OUTF
"============================================================================\n";
print $OUTF "Thread subjects\n";
print $OUTF
"----------------------------------------------------------------------------\n";
foreach my $thread ( sort { "\L$a" cmp "\L$b" } keys %threads )
{
print $OUTF
"$thread : $threads{$thread}{count} : $threads{$thread}{size}\n";
}
print $OUTF
"============================================================================\n";
print $OUTF "Cross-posts\n";
print $OUTF
"----------------------------------------------------------------------------\n";
foreach my $name ( sort keys %crossposts )
{
print $OUTF "$name : $crossposts{$name}\n";
}
print $OUTF
"============================================================================\n";
print $OUTF "User agents\n";
print $OUTF
"----------------------------------------------------------------------------\n";
foreach my $name ( sort keys %agents )
{
print $OUTF "$name : $agents{$name}\n";
}
print $OUTF
"============================================================================\n";
print $OUTF "Time zones\n";
print $OUTF
"----------------------------------------------------------------------------\n";
foreach my $name ( sort keys %tz )
{
print $OUTF "$name : $tz{$name}\n";
}
close $OUTF;
} # write_data