#
# arbitron.waf - Waffle compatible version of parbitron.pl
#                       that was posted to comp.lang.perl in May,1991
#
# modified for MSDOS Waffle by Vince Skahan (victrola!vince)
#
# last modifications:
#       05-25-91 - vds - MSDOS Waffle original
#       06-15-91 - vds - added date code from Brendan Kehoe and Sean Petty
#
#
# usage:        perl arbitron.waf > filename
#
# Waffle specific notes:
#   1. this requires a B-news compatible "active" file.
#        I have a reasonably clean perl script to scan your
#        news spool dir(s) that should get the job done ok...
#        Contact me if you need a copy...
#         (I strongly recommend Brian Carlton's nice and fast
#         active.exe compiled code version over my brutal perl version).
#   2. edit the lines containing $active, $hostname and $userdir
#        to reflect your configuration.  I've moved the variables
#        you have to customize to near the top so you can find them.
#   3. run this program and pipe the output to a file
#   4. mail the edited output to the address referred to in
#        $summarypath as instructed in the "original" comments below.
#   5. this can EASILY be done via cron by putting a line like the
#        following in your 'schedule' file for the 18th or so of
#        each month....(change the paths, etc. to reflect your site)
#
#       active > \waffle\admin\active
#       \data\perl\arbitron.pl > \waffle\admin\arbitron.dat
#       rmail netsurvey@decwrl.dec.com < \waffle\admin\arbitron.dat
#
# Waffle specific limitations:
#
#
#       1. all user homes must be under one tree
#       2. let me know if you find more...
#
# WAFFLE UNIX USERS (!!!) - you don't necessarily want to use this
#               script, which is intended for the PC users.  Assuming
#               unix Waffle has the same join file as MSDOS Waffle, you
#               have to change a handful of lines in the "real" parbitron
#               to make it work...change ".newsrc" everywhere to "join"
#               and take the ":" out in the line that says:
#                       "next if (!/: [0-9]/);"
#               and you'll be 99.9% of the way there...
#
# (the following are the original parbitron release notes...)
#
#parbitron -- a perl version of the program produces rating sweeps for USENET.

# To participate in the international monthly ratings sweeps,
# run "arbitron" every month. Brian Reid runs the statistics program on the
# first day of each month; it will include any report that has reached it by
# that time. To make sure your site's data is included, run the survey
# program no later than the 20th day of each month.

# This version of arbitron was written by Spike (Joe Ilacqua),
# spike@world.std.com.  It seemed like the right thing to do at the time.

# Arbitron was originally written by Brian Reid, DEC Western Research Lab,
# reid@decwrl.dec.com]

# Notes: The Perl version of arbitron intentionally does not support:
#   NN's "~/.nn/rc" file, the current version of NN uses the ".newsrc".
#   Old B News' 2 field active files.
#  You should upgrade your software, or run the shell version of arbitron.

#  As with the shell arbitron, the results of this program are dependent
#  on the rate at which you expire news.  If you are a small site that
#  expires news rapidly, the results may indicate fewer active readers
#  than you actually have.


# Who to send the report to:
# uucp path: {sun, hplabs, pyramid, decvax, ucbvax}!decwrl!netsurvey
$summarypath = 'netsurvey@decwrl.dec.com';

# location of the active file
$active = "c:/waffle/admin/active";     # WAFFLE

# hostname.
$hostname = "victrola";

# location of user homes (under this tree)
$userdir = "c:/waffle/user";

$users = 0;                    # total Users who could read news.
$newsreaders = 0;              # total Users who do read news.

# next 2 statements by Brendan Kehoe (brenadan@cs.widener.edu)
# via email from Sean Petty (uunet!cbmvax!amix!undrground!seanp)

($sec, $min, $hr, $mday, $mon, $year, $wday, $yday, $isdst) =
    gmtime(time+86400);
@months = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul",
	   "Aug", "Sep", "Oct", "Nov", "Dec" );

# my cut at generating a arbitron MmmYY string from Brendon's code above
$dat="@months[$mon]$year";

open(ACTIVE,$active) || die "Can't open active file: $!\n";
while(<ACTIVE>)
{
    next unless /^[a-z][-0-9_a-z]*\./; # from shell arbitron
    ($group,$maximum,$minimum) = split;
    $groupcount{$group} = 0;
    $groupmax{$group} = $maximum;
    $groupmin{$group} = $minimum;
}
close(ACTIVE);

# list the contents of $userdir
chdir($userdir);
opendir (F,".");
@contents = sort readdir(F);
closedir (F);

# filter out "." and ".."
@users=();
foreach $item (@contents) {
        push(@users,$item) unless ($item eq '.' || $item eq '..');
}

# step through the users
foreach $dir (@users)
{
#printf "processing $dir...\n";                 # uncomment to watch it go
chdir ($userdir);

    $users++;

    next if $homes{$dir};      # Don't do a join file twice
    $homes{$dir} = 1;

     next if (! -r "$dir/join");
     open(NEWSRC,"$dir/join") || next; # This shouldn't fail

    $counted = 0;

    while(<NEWSRC>) {
       next if (!/[0-9]/);        # waffle join file has no ":"'s
#       next if (!/: [0-9]/);     # original B-news line FYI
       ($group,$arts) = split;
       $group =~ s/://;

       next unless defined($groupcount{$group}); # bogus group

       next if $hits{$group};  # Don't count a group twice
       $hits{$group} = 1;

       $maximum = $groupmax{$group};
       $minimum = $groupmin{$group};

       next if $minimum == $maximum; # No articles if $minimum == $maximum

# We want the last article read from the line in the .newsrc, it is
# a comma septated number or range (i.e ...,415 or ...,3001-3078)

       @arts = split(',',$arts); # Split the line up on ","s
# Spilt the last element on "-" if need be
       @arts = split('-',$arts[$#arts]) if ($arts[$#arts] =~ /-/);

       if (($arts[$#arts] >= $groupmin{$group})
           && ($arts[$#arts] <= $groupmax{$group})) {
           $groupcount{$group}++;
           if (!$counted) {
               $newsreaders++; # We have found another reader of news
               $counted++;     # only count them once!
           }
       }
    }
    undef %hits;
    close(NEWSRC);
}

undef %groupmax;
undef %groupmin;
undef %homes;

$i = 0;

while (($group,$count) = each %groupcount) {
    $tosort[$i++] = "$count $group";
}

undef %groupcount;

sub nr {  # test like 'sort -nr' for sort function
    ($anum,$astring) = split(' ',$a);
    ($bnum,$bstring) = split(' ',$b);
    if ($anum != $bnum) { -($anum <=> $bnum); }
    else {-($astring cmp $bstring);}
}

@sorted = sort nr @tosort; # sort most read to least

# by default this outputs to the screen...the original unix one
# wrote a message and piped it to mail (can't do in Waffle since there's
# no external mail program).


print "Host\t\t$hostname\n";
print "Users\t\t$users\n";
print "NetReaders\t$newsreaders\n";
print "ReportDate\t$dat\n";
print "SystemType\tnews-perl-arbitron-2.4-waffle-version\n";
print join("\n",@sorted), "\n"; # output the sorted data