Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!tut.cis.ohio-state.edu!cs.utexas.edu!uunet!ssbell!mcmi!denny
From: denny@mcmi.uucp (Denny Page)
Newsgroups: news.software.b
Subject: nstats - Print C news statistics via Perl
Message-ID: <1989Sep29.020352.15711@mcmi.uucp>
Date: 29 Sep 89 02:03:52 GMT
Reply-To: denny@mcmi.UUCP (Denny Page)
Organization: MCMI, Omaha, NE
Lines: 273
In case anybody is interested...
#!/usr/bin/perl
# Nstats - Print C news statistics via Perl
#
#
#
# Author's notes:
#
# Constructive comments and enhancements are solicited (flames are not).
# Please send suggestions or enhancements to denny@mcmi.
#
# Larry Wall has a Very Nice Work in Perl. Many thanks to him.
#
# Denny Page, 1989
#
#
#
# Program notes:
#
# While a duplicate is actually a rejected message, it is treated
# separately here. Rejected messages herein are messages that are not
# subscribed to in the sys file or are excluded in the active file.
#
# Junked messages are not displayed in the system summaries. It's not
# your neighbor's fault that you are missing active file entries. If
# you are concerned about receiving junk groups, exclude them in your
# sys or active file. They will then be summarized :-).
#
# The reason for a newsgroup being bad is assigned only once. If the
# reason changes later in the log (such as the sys file being modified
# such that a newsgroup is no longer rejected, but rather is filed in
# junk), no notice will be taken.
#
# Locally posted messages or messages to pseudo sites (such as mailing
# lists, map unpackers and the like) are given no special treatment in
# the site summaries.
#
# Control messages are not reported in the site summaries. C news does
# not do tracking of control messages other than ihave/sendme anyway.
#
# Sitenames are truncated to 15 characters. This could be done better.
#
#
############################################################
# Revision history:
#
# 09/24/89 dny Initial version
# 09/28/89 dny Added category totals
#
############################################################
################ ***** Change this ***** ###################
#
$newshist="/usr/local/lib/news/bin/maint/newshist";
#
############################################################
# Record the category of a list of message-ids
sub record_groups {
open(newshist, "-|") || exec $newshist, '--', @_;
while () {
if (s/^.+\t.+\t([^\.\/]+).+\n$/$1/) {
foreach $group (split(/ /)) {
$category{$group}++;
}
}
else {
$category{"*expired*"}++;
}
}
close(newshist);
}
############################################################
$#id = -1;
while (<>) {
($from, $action, $message_id, $text) =
/^.+\s(\S+)\s(.)\s<(.+)>\s(.*)$/;
$from = substr($from, 0, 15);
# Accepted message
if ($action eq '+') {
$accept{$from}++;
foreach $site (split(/ /, $text)) {
$site = substr($site, 0,15);
$sent{$site}++;
}
$id[++$#id] = $message_id;
if ($#id >= 24) {
do record_groups(@id);
$#id = -1;
}
next;
}
elsif ($action eq '-') {
# Duplicate
if ($text eq 'duplicate') {
$dup{$from}++;
next;
}
$rej{$from}++;
# Group not in sys
if ($text =~ s/no subscribed groups in `(.+)'/$1/) {
foreach $group (split(/,/, $text)) {
if ($badgroup{$group}++ == 0) {
$badgroup_reason{$group} = "not subscribed in sys";
}
}
next;
}
# Group excluded in active
elsif ($text =~ s/all groups `(.+)' excluded in active/$1/) {
foreach $group (split(/,/, $text)) {
if ($badgroup{$group}++ == 0) {
$badgroup_reason{$group} = "excluded in active";
}
}
next;
}
}
# Junked message
elsif ($action eq 'j') {
$junk{$from}++;
if ($text =~ s/junked due to groups `(.+)'/$1/) {
foreach $group (split(/,/, $text)) {
if ($badgroup{$group}++ == 0) {
$badgroup_reason{$group} = "not in active (junked)";
}
}
next;
}
}
# Ignore ihave/sendme messages
elsif ($action eq 'i') {next;}
elsif ($action eq 's') {next;}
# Unknown input line
print $_;
}
if ($#id >= 0) {
do record_groups(@id);
}
# Collect all sitenames and calc totals
foreach $system (keys(accept)) {
$systems{$system} = 1;
$total_accept += $accept{$system};
}
foreach $system (keys(dup)) {
$systems{$system} = 1;
$total_dup += $dup{$system};
}
foreach $system (keys(reject)) {
$systems{$system} = 1;
$total_rej += $rej{$system};
}
foreach $system (keys(sent)) {
$systems{$system} = 1;
$total_sent += $sent{$system};
}
$total_articles = $total_accept + $total_dup + $total_rej;
# Print system summaries
print "\nSystem Accept sys% tot% Dup sys% tot% Rej sys% Sent avl%\n";
foreach $system (sort keys(systems)) {
$articles = $accept{$system} + $dup{$system} + $rej{$system};
if ($accept{$system} > 0) {
$accept_pct = ($accept{$system} * 100) / $articles + 0.5;
$accept_totpct = ($accept{$system} * 100) / $total_accept + 0.5;
}
else {
$accept_pct = 0;
$accept_totpct = 0;
}
if ($dup{$system} > 0) {
$dup_pct = ($dup{$system} * 100) / $articles + 0.5;
$dup_totpct = ($dup{$system} * 100) / $total_dup + 0.5;
}
else {
$dup_pct = 0;
$dup_totpct = 0;
}
if ($rej{$system} > 0) {
$rej_pct = ($rej{$system} * 100) / $articles + 0.5;
}
else {
$rej_pct = 0;
}
if ($sent{$system} > 0) {
$sent_pct = ($sent{$system} * 100) / $total_accept + 0.5;
}
else {
$sent_pct = 0;
}
printf "%-15s %5d %3d%% %3d%% %4d %3d%% %3d%% %4d %3d%% %5d %3d%%\n",
$system,
$accept{$system}, $accept_pct, $accept_totpct,
$dup{$system}, $dup_pct, $dup_totpct,
$rej{$system}, $rej_pct,
$sent{$system}, $sent_pct;
}
if ($total_accept > 0) {
$accept_pct = ($total_accept * 100) / $total_articles + 0.5;
}
else {
$accept_pct = 0;
}
if ($total_rej > 0) {
$rej_pct = ($total_rej * 100) / $total_articles + 0.5;
}
else {
$rej_pct = 0;
}
if ($total_dup > 0) {
$dup_pct = ($total_dup * 100) / $total_articles + 0.5;
}
else {
$dup_pct = 0;
}
printf "TOTALS %5d %3d%% %4d %3d%% %4d %3d%% %5d\n",
$total_accept, $accept_pct,
$total_dup, $dup_pct,
$total_rej, $rej_pct,
$total_sent;
# Display any bad newsgroups received
@keys = sort(keys(badgroup));
if ($#keys >= 0) {
print "\n\nBad Newsgroups Articles Reason\n";
foreach $group (@keys) {
printf "%-35s %4d %s\n",
$group, $badgroup{$group}, $badgroup_reason{$group};
}
}
# Display news categories received
@keys = sort(keys(category));
if ($#keys >= 0) {
print "\n\nCatagories Received Articles\n";
foreach $heir (@keys) {
printf "%-35s %4d\n",
$heir, $category{$heir};
}
}
--
Someday has arrived