denny@mcmi.uucp (Denny Page) (10/04/89)
Here is a new version of nstats. It fixes a bug in counting the
newsgroup categories for cross posted articles (1.0 only counted the
first link) and contains some minor cleanups.
Thank you for you comments!
#!/usr/bin/perl
#
# Nstats - Print C news statistics via Perl
#
# Version 1.1 (10/03/89)
#
#
#
# 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:
#
# The simplest usage is 'perl nstats ~news/log'. I leave you to find
# more complicated invocations.
#
# 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.
#
# Calls to newshist are cached at 25. This may need to be adjusted at
# some sites.
#
# 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
# 10/02/89 dny Fixed link count bug in record_groups
# 10/03/89 dny Cleaned up varible names
#
############################################################
################ ***** 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 (<newshist>) {
if (s/^.+\t.+\t(.+)\n$/$1/) {
foreach $link (split(/ /)) {
$link =~ s/^([^\.\/]+).*/$1/;
$category{$link}++;
}
}
else {
$category{"*expired*"}++;
}
}
close(newshist);
}
############################################################
$#id_cache = -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_cache[++$#id_cache] = $message_id;
unless ($#id_cache < 25) {
do record_groups(@id_cache);
$#id_cache = -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_cache >= 0) {
do record_groups(@id_cache);
}
# 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\nCategories Received Articles\n";
foreach $group (@keys) {
printf "%-35s %4d\n",
$group, $category{$group};
}
}
--
Someday has arrived