glassmann@ccavax.camb.com (12/29/89)
$! ................... Cut between dotted lines and save. ...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user GLASSMANN
$! on 28-DEC-1989 12:36:14.35.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$! program has been transmitted in 2 parts. You should
$! concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 6 files:
$! AAAREADME.TXT
$! ARBBUILD.COM
$! ARBITRON.C
$! ARBITRON.COM
$! NEWSRC.PATCH
$! UAF.H
$!
$!============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
"VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$VERSION_OK:
$ GOTO START
$!
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK
( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip
<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF
; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip
:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip
<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET )
; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part )
); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line
<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL
( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH
( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1
); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP
; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
( "The following !UL errors were detected while unpacking !AS", i_errors
, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" )
; ENDIF; EXIT;
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed." )
$ RETURN
$!
$START:
$ FILE_IS = "AAAREADME.TXT"
$ CHECKSUM_IS = 1716919986
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XARBITRON - Create statistics to be sent monthly to netsurvey@decwrl.
X
XThis makes heavy use of subroutines that are part of NEWS. Because of
Xthe intertwining of these subroutines, the EXE winds up being over 600
Xblocks. This means that I can't reasonably post the EXE to the net.
XUnfortunately, this means that arbitron is only available to sites with
XC compilers.
X
XTo build arbitron, you first have to include the file NEWSRC.PATCH into
XNEWSRC.C, and recompile it. Then compile and link arbitron. ARBBUILD.COM
Xis included for this purpose, but you'll probably have to modify it for
Xyour site.
X
XARBITRON.COM should be run monthly. This will also have to be modified
Xfor your site.
X
XLenny Glassmann
Xlenny@ccavax.camb.com
Xuunet!ccavax!lenny
$ GOSUB UNPACK_FILE
$ FILE_IS = "ARBBUILD.COM"
$ CHECKSUM_IS = 1027810274
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$ cc/include=news_src arbitron
X$ link arbitron,[.news_build]news_library/lib,news_src:options_c_link/opt
$ GOSUB UNPACK_FILE
$ FILE_IS = "ARBITRON.C"
$ CHECKSUM_IS = 1140914158
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/* ARBITRON.C - Calculate number of readers of each newsgroup for ANU NEWS.
X`009This is meant to be run once per month, with results mailed to
X`009netsurvey@decwrl.dec.com on about the 20th of every month.
X`009The results are placed in the file ARBITRON.OUT.
X
X`009The NEWS database is read to determine what is the oldest and newest
X`009item number still on the system for each newsgroup. Then each
X`009user's NEWSRC file is read to determine what the last item was
X`009that the user read. If the last item read is later than the oldest
X`009one still on the system, then the user is counted as a reader of
X`009the newsgroup.
X
X`009This program makes heavy use of subroutines that are part of NEWS to
X`009read the files. This is not the most efficient way to read these
X`009files because work is done by those subroutines which is not needed
X`009by this program. However, it made this easy to write and maintain,
X`009and since it only runs once a month, we don't care how long it takes.
X
X`009Just about all of the numbers generated by this program are estimates
X`009of some kind. Number of users on the system is the number of
X`009accounts that have logged on interactively in the past 30 days. Number
X`009of news readers is the number of users who are readers of at least
X`009one newsgroup. A reader of a newsgroup is someone who has read an
X`009article that has an item number between the lowest and highest
X`009currently stored in the newsgroup.
X
X`009This has only been tested with ANU NEWS V5.9C, VAX C V3.0, VMS V5.2.
X`009If you have another configuration, you'll probably have to at least
X`009recompile this module.
X
X`009This must run from a place that has read access to every NEWSRC
X`009file on the system. The NEWSRC files must be in the user's
X`009default directory to be counted.
X
X`009Lenny Glassmann
X`009Cambridge Computer Associates
X`00956 Beaver St.
X`009New York, NY 10004
X`009(212) 425-5830
X`009lenny@ccavax.camb.com
X
XThanks to:
X`009Geoff Houston (gih900@csc.anu.oz.au) for ANU NEWS.
X`009Joe Meadows (joe@fhcrcvax.bitnet) for the UAF reading code.
X`009Brian Reid (reid@decwrl.dec.com) for the original UNIX arbitron.
X
XHistory:
X`009Dec 27 1989 - Initial release.
X*/
X
X#include "newsinclude"
X#include lnmdef
X#include libdef
X#include "uaf"
X#include "newsdefine"
X
X#define extrnl
X#define iev(v)`009= v
X#define iv(v)`009v
X#include "newsvariables"
X
Xtypedef struct
X `123
X char name[SUBJLEN];
X unsigned int low_item;
X unsigned int high_item;
X unsigned short readers;
X `125 GRP_INFO;
X
Xtypedef struct u_struct
X `123
X char *devdir;
X char *name;
X struct u_struct *next;
X `125 USER_STRUCT;
X
Xtypedef unsigned long SYSTIME[2];
X
Xstatic struct FAB uaffab;
Xstatic struct RAB uafrab;
Xstatic struct UAFDEF record;
Xstatic FILE *outfile;
Xstatic GRP_INFO *grparray;
Xstatic SYSTIME curtime;
Xstatic char version[] = "vms-arbitron-1.0";
Xstatic int news_readers = 0;
Xstatic int num_users = 0;
X
X
Xarbitron ()
Xmain_program
X`123
Xchar reg_filename[] = "newsrc";
X$DESCRIPTOR (delta_d, "30 0");`009`009/* Thirty days */
Xregister int grp_num;
XITM_PTR itmptr;
Xregister GRP_PTR group;
Xchar *cp;
Xchar *cp2;
Xint lastread;
Xchar user_reads_news;
Xint devlen;
Xint dirlen;
Xshort namelen;
Xchar username[UAF$S_USERNAME + 1];
XSYSTIME delta_t;
XSYSTIME month_ago;
X
X /* figure out the date that was 30 days ago */
X sys$gettim (&curtime);
X sys$bintim (&delta_d, &delta_t);
X lib$sub_times (&curtime, &delta_t, &month_ago);
X
X openfiles ();`009/* open and read NEWS.GROUPS */
X open_uaf ();`009/* open SYSUAF.DAT */
X open_outfiles ();
X
X grparray = malloc (sizeof (GRP_INFO) * ga_size);
X
X /* inspect each group (group 0 is not used) */
X for (grp_num=1; grp_num <= ga_size; grp_num++)
X`009`123
X`009map_items (grp_num);`009`009/* read NEWS.ITEMS */
X`009group = ga[grp_num];
X`009strcpy (grparray[grp_num].name, group->grp_name);
X`009itmptr = group->grp_ia;
X`009if (group->grp_count > 0)
X`009 `123
X`009 /* get high and low item numbers (itmptr[0] is not used) */
X`009 grparray[grp_num].low_item = itmptr[1].itm_num;
X`009 grparray[grp_num].high_item = itmptr[group->grp_count].itm_num;
X`009 `125
X`009else
X`009 `123
X`009 grparray[grp_num].low_item = 0;
X`009 grparray[grp_num].high_item = 0;
X`009 `125
X`009grparray[grp_num].readers = 0;
X`009free (group->grp_ia);`009`009/* no longer need item list */
X`009`125
X
X while (SYS$GET (&uafrab) & 1)`009/* read every record in the UAF */
X`009`123
X`009cp = username;
X`009cp2 = record.uaf$t_username;
X`009namelen = 0;
X`009while ((*cp2 != ' ') && (namelen++ < UAF$S_USERNAME))
X`009 *cp++ = *cp2++;
X`009*cp = '\0';
X
X`009printf ("%s ", username);
X
X`009if (lib$sub_times (&record.uaf$q_lastlogin_i, &month_ago,
X`009`009`009`009`009`009&delta_t) == LIB$_NEGTIM)
X`009 `123
X`009 printf ("hasn't logged in this month\n");
X`009 continue;`009`009`009`009/* skip this user */
X`009 `125
X
X`009num_users++;
X
X`009devlen = *record.uaf$t_defdev;
X`009dirlen = *record.uaf$t_defdir;
X`009if (devlen + dirlen + strlen (reg_filename) + 1 > sizeof(news_register))
X`009 `123
X`009 printf ("register file name is too long\n");
X`009 exit (0);
X`009 `125
X`009memcpy (news_register, &record.uaf$t_defdev[1], devlen);
X`009memcpy (news_register + devlen, &record.uaf$t_defdir[1], dirlen);
X`009*(news_register + devlen + dirlen) = '\0';
X
X`009/* if more than one user has the same default directory, and therfore
X`009 the same NEWSRC file, we only want to count it once.`009`009 */
X`009if (duplicate_user (news_register, username))
X`009 continue;
X
X`009strcat (news_register, reg_filename);
X
X`009if (access (news_register, 0) != 0)
X`009 `123
X`009 printf ("no NEWSRC file found\n");
X`009 continue;`009`009`009/* skip this user */
X`009 `125
X
X`009clear_profile_flags ();`009/* get rid of profile info from other users */
X`009read_reg_file ();`009/* read the NEWSRC file */
X`009user_reads_news = FALSE;
X
X`009for (grp_num=1; grp_num <= ga_size; grp_num++)
X`009 `123
X`009 group = ga[grp_num];
X`009 if (group->grp_reg_text)
X`009`009`123
X`009`009cp = group->grp_reg_text +
X`009`009`009strlen (group->grp_reg_text) - 1;
X`009`009while (isdigit (*cp)) /* find last non-digit */
X`009`009 --cp;
X`009`009lastread = atoi (++cp);
X`009`009free (group->grp_reg_text);
X`009`009group->grp_reg_text = NULL;
X`009`009if ((grparray[grp_num].low_item !=
X`009`009`009`009`009grparray[grp_num].high_item) &&
X`009`009 (lastread >= grparray[grp_num].low_item) &&
X`009`009 (lastread <= grparray[grp_num].high_item))
X`009`009 `123
X`009`009 grparray[grp_num].readers++;
X`009`009 user_reads_news = TRUE;
X`009`009 `125
X`009`009`125
X`009 `125
X`009if (user_reads_news)
X`009 `123
X`009 news_readers++;
X`009 printf ("reads news\n");
X`009 `125
X`009else
X`009 `123
X`009 printf ("doesn't read news\n");
X`009 `125
X`009`125
X
X sort_output ();
X write_header ();
X write_data ();
X`125
X
Xwrite_header ()
X`123
Xchar *cp;
Xunsigned int ret;
Xchar timbuf[13];
X$DESCRIPTOR (timbuf_d, timbuf);
X$DESCRIPTOR (systbl, "LNM$SYSTEM_TABLE");
X$DESCRIPTOR (addr_log_d, "NEWS_ADDRESS");
Xunsigned short hostlen;
Xchar hostnam[80];
Xstruct
X `123
X unsigned short buflen;
X unsigned short itmcode;
X char *buf_addr;
X int *retlen;
X `125 hostitm[] =
X`009`123`123sizeof (hostnam) - 1, LNM$_STRING, &hostnam, &hostlen`125,
X`009`1230, 0, 0, 0`125`125;
X
V if ((ret = sys$trnlnm (0, &systbl, &addr_log_d, 0, &hostitm)) != SS$_NORM
XAL)
X`009lib$stop (ret);
X hostnam[hostlen] = '\0';
X
X for (cp = hostnam; *cp; cp++)
X`009*cp = _tolower (*cp);
X fprintf (outfile, "Host %s\n", hostnam);
X fprintf (outfile, "Users %d\n", num_users);
X fprintf (outfile, "NetReaders %d\n", news_readers);
X sys$asctim (0, &timbuf_d, &curtime, 0);
X fprintf (outfile, "ReportDate %c%c%c%.4s\n",
X`009timbuf[3], _tolower(timbuf[4]), _tolower(timbuf[5]), &timbuf[7]);
X fprintf (outfile, "SystemType %s\n", version);
X`125
X
Xwrite_data ()
X`123
X GRP_INFO group_rec;
X struct dsc$descriptor rec_d;
X unsigned int ret;
X
X rec_d.dsc$w_length = sizeof (group_rec);
X rec_d.dsc$b_dtype = DSC$K_DTYPE_T;
X rec_d.dsc$b_class = DSC$K_CLASS_S;
X rec_d.dsc$a_pointer = &group_rec;
X
X while ((ret = sor$return_rec (&rec_d)) == SS$_NORMAL)
X`009fprintf (outfile, "%d %s\n", group_rec.readers, group_rec.name);
X
X if (ret != SS$_ENDOFFILE)
X`009lib$stop (ret);
X`125
X
X/* sort the newsgroup lines in descending order by number of readers */
Xsort_output ()
X`123
X unsigned int ret;
X unsigned short sort_buf[] =
X`009`1231, DSC$K_DTYPE_WU, 1,
X`009(char *)&grparray[0].readers - (char *)&grparray[0],
X`009sizeof (grparray[0].readers)`125;
X unsigned short reclen = sizeof (grparray[0]);
X struct dsc$descriptor rec_d;
X unsigned int grp_num;
X
X if ((ret = sor$begin_sort (&sort_buf, &reclen, 0, 0, 0, 0, 0, 0, 0)) !=
X`009`009`009`009`009`009`009`009 SS$_NORMAL)
X`009lib$stop (ret);
X rec_d.dsc$w_length = sizeof (grparray[0]);
X rec_d.dsc$b_dtype = DSC$K_DTYPE_T;
X rec_d.dsc$b_class = DSC$K_CLASS_S;
X
X for (grp_num=1; grp_num <= ga_size; grp_num++)
X`009`123
X`009rec_d.dsc$a_pointer = &grparray[grp_num];
X`009if ((ret = sor$release_rec (&rec_d)) != SS$_NORMAL)
X`009 lib$stop (ret);
X`009`125
X
X if ((ret = sor$sort_merge (0)) != SS$_NORMAL)
X`009lib$stop (ret);
X`125
X
X
X/* check for users who have the same default directory */
Xduplicate_user (devdir, name)
Xchar *devdir;
Xchar *name;
X`123
X static USER_STRUCT *top_user = NULL;
X register USER_STRUCT *userp;
X register USER_STRUCT *new;
X USER_STRUCT *prev;
X char past = FALSE;
-+-+-+-+-+ End of part 1 +-+-+-+-+-
--
Lenny Glassmann glassmann@ccavax.camb.com