/*
** ADDNKEYS EXEC
** A Rexx program for use under VM/CMS, which reads in a NAMES file,
** and for every name inserts a WWP key.
**
** Copyright 1997 by Syd Bauman and Brown University.
**   This program is free software; you can redistribute it and/or
** modify it under the terms of the GNU General Public License as
** published by the Free Software Foundation; either version 2 of the
** License, or (at your option) any later version.
**   This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** merchantability or fitness for a particular purpose. See the GNU
** General Public License for more details.
**   You should have received a copy of the GNU General Public
** License along with this file; if not, write to the
**   Free Software Foundation, Inc.
**   675 Mass Ave
**   Cambridge, MA  02139
**   USA
**   gnu@prep.ai.mit.edu.
**
** parameters: one optional argument, the filename of a NAMES file.
**     all other arguments are summarily ignored. If no filename is
**     specified, the 'userid' NAMES file is used.
** input: a NAMES file. For format of a NAMES file see usage note in
**     NAMEFIND HELPCMS.
** output: same NAMES file is copied to the D-disk with keys added.
**     Keys are in the format
**         :key.FLpddc
**     where:
**     ":key." is literal -- it's the tag;
**     "F" is the first initial, if there is one;
**     "L" is the first 1-8 (or 1-9 iff no first initial) letters of
**         the last name;
**     "p" is a period;
**     "dd" is two randomly generated disambiguation letters;
**     "c" is a check letter.
**     If there is no R/W D-disk, or it is not big enough, an error
**     message from the 'file' subcommand of XEDIT will be generated,
**     and the output file will remain in memory per XEDIT.
**
** Credits
** -------
** Original concept: John Lavagnino
** Details: WWP encoding staff
** Revised concept: Syd Bauman
** Algorithm: Norman Bauman
** Coding: Syd Bauman
**
** revision hx:
** -------- --
** 1997-05-30 by Syd Bauman: finished version 1.
** 1997-05-29 by Syd Bauman: created, based on my N2K EXEC.
**
*/
 
/*
** Parse arguments. Should be one and only one: a filename.
** If there isn't one, use the Userid() NAMES file.
*/
arg fn .
if fn = '' then fn = Userid()
 
/*
** Ensure that the file we are going to read
** is not on the D-disk (which is where we are
** going to try to write).
*/
'pipe cms listfile' fn 'names * (fm',
    '| take 1',         /* take top file (sorted by FM) */
    '| specs word 3 1', /* take only the filemode */
    '| specs 1 1',      /* take only letter (leaving digit) */
    '| var names_fm'    /* put into a Rexx variable */
if names_fm = 'D' then call Error 24,
    "Sorry, but ADDNKEYS won't work on a file on the D-disk."
 
/*
** Initialize "constants"
*/
alphaplus = "abcdefghijklmnopqrstuvwxyz*"
 
/*
** Extract a list of nicknames from the
** NAMES file.
*/
'pipe <' fn 'NAMES',        /* read in entire file */
     '| xlate lower',       /* translate to lower case */
     '| split',             /* each "word" on a separate record */
     '| locate /:nick./',   /* keep only those records w/ nick tags */
     '| strip both',        /* nuke leading & trailing blanks */
     '| specs 7-* 1',       /* nuke tag, keeping only value */
     '| stem nicks.'        /* put into Rexx array */
 
/*
** Loop through for each nickname
*/
do n = 1 to nicks.0
 
   /*
   ** Retrieve the name and linenumber in the NAMES file
   ** associated with this nickname
   */
  'NAMEFIND :nick' nicks.n ':name (size 0 linenum lifo file' fn
   if rc = 0 then do
      parse pull name
      pull line.n
      end
   else call Error 36,
     "Unexpected return code" rc "from NAMEFIND :nick" nicks.n"."
 
   /*
   ** If there was no :name., this is an unknown soldier
   */
   if name = '' then name = "Unknown"
 
   /*
   ** parase name into surname and rest-of-name
   ** (of which we will only use 1st char)
   */
   if Index( name,',') > 0 then do
      /*
      ** there is a comma, presume this one is
      ** in lastname-first format
      */
      parse VAR name surname ',' rest
      end
   else do
      /*
      ** there is no comma, presume the surname is
      ** the last word.
      ** WARNING -- this algorithm messes up with names
      ** ending in "Jr.", "III", "Esq.", etc.!!
      */
      parse VALUE Reverse( name ) WITH emanrus tser
      surname = Reverse( emanrus )
      rest = Reverse( tser )
      end
 
   /*
   ** remove leading & trailing blanks
   */
   surname = Strip( surname )
   rest = Strip( rest )
 
   /*
   ** remove hyphen and apostrophe
   ** (this should be updated to remove all
   ** non-alphabetics)
   */
   ksurname = Space( Translate( surname, " ", "'-" ), 0 )
 
   /*
   ** create initial portion of key
   ** if there is no first name, use chars 1-9 of surname;
   ** if there is a first name, use first char of first
   ** name, then chars 1-8 of surname.
   */
   if rest = '' then krnam = Substr( ksurname, 1, 9 )
   else krnam = Substr( rest, 1, 1 ) || Substr( ksurname, 1, 8 )
   krnam = Strip( krnam )
 
   /*
   ** pad to 9 chars with asterisks, and translate
   ** to lower case
   */
   kpnam = Lower( Left( krnam, 9,"*") )
 
   /*
   ** add disambiguation and check characters
   ** (actual algorithm)
   */
   u = 26   /* so we get to go through loop at least once */
   do until u < 26
      /*
      ** generate two disambiguation letters at random
      */
      disambig = Substr( alphaplus, Random( 1, 26 ), 1 )
      disambig = disambig || Substr( alphaplus, Random( 1, 26 ), 1 )
      /*
      ** appending them to the initial portion of key (translated
      ** to lower case and padded w/ asterisks) gives us almost
      ** a complete key -- wer're only missing the check character.
      */
      tokey = kpnam || disambig
      /*
      ** now generate the check 'digit'. We do this by calculating
      ** the value of the string stored in variable "tokey" (the
      ** initial portion of key translated to lower case and
      ** padded w/ asterisks) as if it were a number base 27,
      ** taking that number modulo 29; a further (and not
      ** necessary) refinement is then performed: the result is
      ** subtracted from a magic constant.
      */
      u = 0
      do i = 1 to 11
         u = u + index( alphaplus, substr( tokey, i, 1 ) ) -1
         u = u * 27
         u = u // 29    /* see note [1] */
         end
      u = ( 56 - u ) // 29
      /*
      ** Now we have our number. But it is in the range
      ** 0-28 (where 0=a, 1=b, ... 25=z, but 26-28 don't
      ** map to anything), and we want a number in the
      ** range 0-25. So if it's 26 or more, we just repeat
      ** the process with two new random disambiguation
      ** characters.
      */
      end   /* do until u < 26 */
 
   /*
   ** convert the number to a letter
   */
   cchar = Substr( alphaplus, u+1, 1 )
 
   /*
   ** and create the key by combining
   ** the initial portion of the key,
   ** a period, the disambiguation
   ** characters, and the check character.
   */
   key.n = krnam"."disambig || cchar
 
   /*
   ** Note the ".n" -- we are creating an array
   ** of keys, one for each name.
   */
   end  /* do n = 1 to nicks.0 */
 
/*
** Now that we have created the array of keys,
** we need to stick them in the NAMES file. We
** do this by stacking a series of search-and-
** insert commands for XEDIT, and then invoking
** said editor.
*/
/*
** first stack our finis command, which saves the
** file to the D disk and closes the file (quitting
** XEDIT if no other files are open).
*/
push "file = = d"
/*
** Now loop through and push each locate subcommand
** (which also executes the input subcommand) on the
** stack. Note that order is important -- by pushing
** them from lowest line number to highest on the
** stack we allow them to be executed from highest
** to lowest. If we did the reverse (execute them
** from lowest to highest) each input subcommand
** would add a line, thus rendering the next line.i
** off-by-one-more.
*/
do i = 1 to nicks.0
   push "locate :" line.i "input :key."key.i
   end
/*
** All stacked up and nowhere to go, so
** give all those commands somewhere to
** go. Note that the noprofile option is
** important so that the user's profile
** doesn't do something like redifine one
** of the subcommands we rely upon.
*/
'xedit' fn 'names * (noprofile'
exit rc
 
/*
** Notes
** -----
** [1] The loop is used to "build up" the number u, as I don't know
**     any other way to calculate what tokey base 27 is in base 10.
**     But if we set numeric digits high enough, we would not
**     actually need to perform the modulus operation each time
**     through the loop -- we could perform it once at the end with
**     the exact same result. I.e., we could use
**         u = 0
**         do i = 1 to 11
**             u = (u+index( alphaplus, substr( tokey, i, 1 ) ) -1)*27
**             end
**         cchar = Substr( alphaplus, 28-u//29, 1 )
**     if we were dramatically more interested in speed and brevity
**     than clarity.
*/
 
/*---------------------------------------------------------------------*/
Error:  procedure
parse arg code msg
say msg
exit code
/*---------------------------------------------------------------------*/