arbitron in perl 
Author Message
 arbitron in perl

Hi netters,

I remember seeing an arbitron clone written in perl go by a few (?) months
back.  I sure would like to get a copy.  Is it ftp'able?  Would someone be
willing to email it?  I can't imagine it being very long.

Thanks in advance.

Tom
--

-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
I gotta get away from this day to day running around.
Everybody knows this is nowhere.  - Neil Young



Fri, 01 Apr 1994 22:02:25 GMT  
 arbitron in perl


   ----- Transcript of session follows -----
bad system name: chrysanthemum
uux failed. code 68
550 chrysanthemum!wyvern!tmanos... Host unknown

   I remember seeing an arbitron clone written in perl go by a few (?) months
   back.  I sure would like to get a copy.  Is it ftp'able?  Would someone be
   willing to email it?  I can't imagine it being very long.

Here is my version. It has the additional ability to spawn itself
through a network to collect the statistics.

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#

# Source directory /nfs/pronto/mozart/users/jv/src/arbitron
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#  13286 -r--r--r-- arbitron.pl
#    422 -rwxr-xr-x nd_arbitron
#
# ============= arbitron.pl ==============
if test -f 'arbitron.pl' -a X"$1" != X"-c"; then
        echo 'x - skipping arbitron.pl (File already exists)'
else
echo 'x - extracting arbitron.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'arbitron.pl' &&
X#!/usr/bin/perl -s
Xeval "exec /usr/bin/perl -S -s $0 $*"
X  if $running_under_some_shell;
X
X# arbitron.pl -- perl version 1.1.8

X# Author          : Johan Vromans
X# Created On      : Sat Nov 11 00:17:06 1989
X# Last Modified By: Johan Vromans
X# Last Modified On: Sun Jun 24 11:58:38 1990
X# Update Count    : 51
X# Status          : Production
X
X# For each user on this system, it tries to read ".newsrc",
X# ".rrnewsrc" or ".nn/rc" whichever is present and not older than 4
X# weeks.
X#
X# Duplicate .newsrc's, mostly due to users who have different login's,
X# are skipped.
X#
X# When requested, it copies itself to remote systems which have
X# nntp-based news-clients, runs there, and accumulates the results.
X# Remote newsreaders are counted as readers and as users of the local
X# system which -in a way- they are.
X#

X# This program may be distributed under the terms of the GNU Public Licence.
X
X################ Usage ################
X#
X# Usage:
X#
X#   [perl -s] arbitron.pl [-log] [-nomail] [-nolocal] [-noremote] \
X#                        [-suppress] [-prebuilt]
X#                        [-slave slavehost active masterhost]
X#                        [prebuilt files]
X#
X# Options:
X#    -log      : causes verbose processing
X#    -nomail   : do not report via mail, but to STDOUT
X#    -nolocal  : do not process local readers
X#    -noremote : do not attempt to fork to remote systems
X#    -suppress : do not report groups with zero readers
X#    -prebuilt : read prebuilt collection from files
X#    -slave    : internally used for remote systems processing
X#
X# Needs write access to the /usr/tmp filesystem.
X#
X# For remote systems processing, needs "rcp" and "rsh" capabilities,
X# and write access to the remote /usr/tmp filesystem.
X# Of course, perl has to be installed on each of the remote systems
X# also.
X#
X# You may customize the "Run-Time Options" section and the
X# "Configuration Section" to tailor the program for your site specific
X# needs.
X# Optionally, a local file "arb.cfg" is read to set the slaves list.
X
X################ Messages ################
X#
X# Messages are all preceded by "+[host]:" to show the system where
X# they originate from.
X#
X# arbitron.pl 1.XX.YY - news-arbitron
X#      informational greeting
X# active: NNN of XXX groups
X#      XXX groups in active file, NNN with articles
X# prebuilt: NNN readers
X#      The prebuilt files apparently consisted of NNN concatenated
X#      newsrc files.
X# prebuilt: XXX of YYY of ZZZ groups
X#      ZZZ groups (lines) in the prebuilt files, of which there were YYY
X#      subscribed groups, of which XXX were taken into account.
X# skipped ~USER1/RC = ~USER2/RC (NEWSRC)
X#      USER1 and USER2 shared the same newsrc. This occurence is skipped.
X# cannot open NEWSRC, skipped
X#      This particualr newsrc file could not be read
X# ~USER/RC: XXX of YYY of ZZZ groups
X#      This user has ZZZ groups, of which YYY with articles in his
X#      RC, and was subscribed to XXX groups.
X# XXX readers of YYY users
X#      YYY users on this system, of which XXX (different) news readers
X# spawning to XXX
X#      informational - remote processing to XXX starts
X# rsh perl -s /tmp/tmpp$$ -slave XXX /tmp/tmpa$$ -log
X#      informational: the command to remotely execute
X# !Cannot run on XXX, continuing
X#      the perl program did not complete on remote system XXX
X# sending to |mail ....
X#      informational: where the report goes to
X#
X# Fatal errors:
X#
X# !Sorry, this program requires perl 3.0 patch level 1 or later
X#      cannot continue because of missing features
X# !Cannot open ACTIVE
X#      cannot continue without an active file
X# !Fatal error on XXX
X#      a fatal error occurred on remote system XXX
X# !Cannot open |mail ...
X#      no way to get the report out
X
X################ Preamble ################
X
X$thisprog = $0;

X($version,$patchlevel) = $] =~ /(\d+.\d+).*\nPatch level: (\d+)/;
Xdie "!Sorry, this program requires perl 3.0 patch level 1 or later\nStopped"
X  if $version * 1000 + $patchlevel < 3001;
X
X################ Run-Time Options ################
X
X# verbose output
X$log = 0 unless defined $log;
X
X# Slave mode. Used to recurse through systems.
X# Calling sequence: perl -s arb.pl -slave hostname active-file
X$slave = 0 unless defined $slave;
X
X# do not process local newsreaders
X$nolocal = 0 unless defined $nolocal;
X
X# do not process remote newsreaders
X$noremote = 0 unless defined $noremote;
X
X# don't send mail (output to stdout)
X$nomail = 0 unless defined $nomail;
X
X# suppress groups with zero readers
X$suppress = 0 unless defined $suppress;
X
X# take additional input from pre-gathered .newsrc's
X$prebuilt = 0 unless defined $prebuilt;
X
X################ Configuration Section ################
X
X# this host name. $reporthost defaults to $host if not set
Xif ( !$slave) {
X    chop ($host = `uuname -l`);        # local UUCP name
X    $reporthost = "mh.nl";   # name for report
X}
X
X# name of the (real) active file
X$active = "/usr/lib/news/active";
X
X# local user who gets a copy of the report mailed
X$user = $ENV{"LOGNAME"} unless $user = $ENV{"USER"};
X
X# destination of the report, unless -nomail
X$dest = "|/usr/bin/mailx -s \"Arbitron report\" $user " .

X
X# remote systems to traverse
Xif (open (cfg, "./arb.cfg")) {

X  close (cfg);
X} else {

X}
X
X# how to remotely execute a command
X$rsh = "remsh";
X
X################ End of Configuration Section ################
X
X$users = 0;
X$readers = 0;
X$dest = ">&STDOUT" if $nomail || $slave;
Xif ( $slave ) {



X  $msg = "STDOUT";
X}
Xelse {
X  $msg = "STDERR";

X}
X
X################ Subroutines ################
X
X# message on STDERR (STDOUT for slave) if -log
X
Xsub msg {

X}
X
X# Read the local active file.
X# Fills array %newsgroups with 0 (empty group) or 1 (group with articles).
X# Note: cannot use 'defined(...)' since user .newsrcs may contain
X# bogus info
X
Xsub getactive {
X
X  local ($group, $high, $low);
X  local ($count, $total, $tmp) = (0, 0, 0);
X
X  open (active, $active) || die ("!Cannot open $active, stopped");
X
X  undef %newsgroups;   # make sure it is empty
X
X  if ( $slave ) {
X
X    while ( <active> ) {
X      chop;
X      $newsgroups{$_} = 1;
X      $count++;
X    }
X    $total = $count;
X
X  }
X  else {
X
X    while ( <active> ) {
X
X      ($group, $high, $low, $tmp) = split ;
X      $total++;
X      if ( $high <= $low ) {
X       # group without articles ({*filter*} or expired)
X       $newsgroups{$group} = 0;
X      }
X      else {
X       $newsgroups{$group} = 1;
X       $count++;
X      }
X    }
X  }
X  close (active);
X
X  do msg ("active: $count of $total groups");
X
X}
X
X# read prebuilt data
X
Xsub readprebuilt {
X
X  local ($Lreaders);
X  local ($line, $group);
X  local ($total, $subscr, $count);
X
X  while ( $line = <> ) {
X
X    $total++;
X
X    $group = "";
X
X    # alt.sources: 1-01234
X    # ":" may also be "!", which indicates an unsubscribed group
X    if ( $line =~ /^general\s*[:!]/ ) {
X      $Lreaders++;
X    }
X    $group = $1 if $line =~ /^([^:!]+):/ ;
X    next if $' =~ /\s*0+$/;
X
X    # only take subscribed groups
X    if ( $group ne "" ) {
X      $subscr++;
X
X      # only take groups which have (had) articles
X      if ( $newsgroups{$group} > 0 ) {
X       $newsgroups{$group}++;
X       $count++;
X      }
X    }
X  }
X
X  # Note: count and subscr can be > total, since the prebuilt
X  # data is a concatenation of newsrc's.
X  do msg ("prebuilt: $Lreaders readers");
X  do msg ("prebuilt: $count of $subscr of $total groups");
X  $users += $Lreaders;
X  $readers += $Lreaders;
X
X  return 1;
X}
X
X# process local users
X
Xsub getlocalreaders {
X
X  local ($Lreaders, $Lusers);

X  local ($user, $pwd, $dir, $Z);
X  local ($tlimit) = time - (28 * 24 * 60 * 60);
X
X  undef %newsrcs;
X
X  setpwent;
X
X  while (($user,$pwd,$Z,$Z,$Z,$Z,$Z,$dir,$Z) = getpwent) {
X
X    next if ord($pwd) == ord("*");   # blocked login
X    next unless -d $dir;                       # no home dir
X
X    $Lusers++;
X
X    # only take newsreaders with a .newsrc less than 4 weeks old
X    # read_newsrc will take care of duplicate newsrc's
X
X    # .rrnewsrc is used by remote (nntp-based) readers like rrn and rvn

X      $Lreaders += do read_newsrc ($user, ".rrnewsrc",
...

read more »



Sun, 03 Apr 1994 06:28:35 GMT  
 
 [ 2 post ] 

 Relevant Pages 

1. Arbitron in PERL

2. Better usenet arbitron in perl

3. NYC: PERL PERL PERL PERL PERL PERL PERL

4. Perl, perl or PERL debate

5. Perl Golf mailing list - perl.golf on nntp.perl.org

6. Perl, Perl, Perl, don't give your love to URL

7. RFD - comp.lang.perl.db, comp.lang.perl.network, comp.lang.perl.regex

8. \c@ in Perl, perl & perl + modules

9. New dialect of perl: xperl (or reinventing perl, or perl-izing jpython)

10. Perl/Swing (Perl/AWT) as an eventual alternative to Perl/Tk

11. Perl *is* strongly typed (was Re: Perl description)

12. Perl syntax and beyond (was: Re: Perl style and module searches)

 

 
Powered by phpBB® Forum Software