Aminet 10/aminetcdnumber101996.iso/Aminet/util/rexx/ScionRexx.lha/Soundex.rexx

OS/2 REXX Batch file | 1995-10-31 | 13KB | 383 lines

/****************************************************************************
 *                                                                          *
 * $VER: Soundex 1.05 (28 Oct 1995)
 *                                                                          *
 *                      Written by Freddy Ariës                             *
 * Address: Lindeboomweg 7, NL-7135 KE Harreveld, The Netherlands.          *
 *                                                                          *
 * Program for Scion Genealogist 4.0 and above (no guarantees are given     *
 * for lower versions). This program should ask the user for a surname,     *
 * and output the list of names in the current Scion database that match    *
 * the entered name, using the SOUNDEX method of name comparison.           *
 * Scion Genealogist must be running for this script to work.               *
 *                                                                          *
 * This script uses (by default) the rexxreqtools.library (which requires   *
 * a version of reqtools larger than 2.0 and rexxsyslib.library)            *
 * If you do not have these, run SetDefaults.rexx to change the settings.   *
 *                                                                          *
 * For those who don't know what SOUNDEX is, here is a short intro:         *
 *                                                                          *
 * The Soundex system is the means established by the National Archives     *
 * to index the U.S. censuses (beginning with 1880). It codes together      *
 * surnames of the same and similar sounds but of variant spellings.        *
 * Soundexes are arranged by state, Soundex code of the surname, and        *
 * given name.                                                              *
 *                                                                          *
 * Soundex codes begin with the first letter of the surname followed by a   *
 * three-digit code that represents the (first three) remaining consonants. *
 * This Soundex converter will do the tricky work for you and capture the   *
 * nuances of the coding scheme (such as coding adjacent like letters as    *
 * one). Just enter the surname that you want coded.                        *
 *                                                                          *
 * Soundex Coding Guide                                                     *
 *  1 = B,P,F,V                                                             *
 *  2 = C,S,G,J,K,Q,X,Z                                                     *
 *  3 = D,T                                                                 *
 *  4 = L                                                                   *
 *  5 = M,N                                                                 *
 *  6 = R                                                                   *
 *                                                                          *
 * The letters A,E,I,O,U,Y,H and W are not coded.                           *
 *                                                                          *
 * Note that surname prefixes such as Van, Von, Di, De, Le, D', dela, or    *
 * du are sometimes disregarded in alphabetizing and in coding.             *
 * Therefor it is wise to code it with and without the prefix because it    *
 * may be listed under either code. Eg. Van Hoesen could be coded as        *
 * VanHoesen or as Hoesen.                                                  *
 *                                                                          *
 * DONE:                                                                    *
 * - 2 consecutive letters with the same code are now treated as one        *
 *   eg. LLOYD=LOYD -> [LD=L300], and JACKSON (CKS are all 2) -> [JCN=J250] *
 * - now uses preference file for default settings                          *
 *                                                                          *
 * TO DO (but low priority):                                                *
 *  - Automatically do the above coding (2 alternatives) for prefixes.      *
 *  - Suggestions, comments, bugreports, donations, etc. are appreciated.   *
 *                                                                          *
 ****************************************************************************/

options failat 20; options results
arg srchstr outname outval

versionstr = "1.05"

/* Don't change the settings here! Run SetDefaults.rexx instead! */
usereq = 1; outp = 1; scrdev = stdout
plwidth = 78
PSCR = "SCIONGEN"
scrname = "CON:0//639//Scion Output/AUTO/SCREEN"

sxlen = 3;  /* the default length of the soundex-code is 3,
         * but if you insist, you can use a longer code
         */
NL = '0A'x

signal on IOERR

do while srchstr = '?'
  writeln(stdout, "SEARCHNAME/A,OUTFILE/A,QUIET/S,NOREQ/S ")
  pull srchstr outname outval
end

/* read preferences file */

if open(pfile, 'ENV:Scion/ScionRexx.prefs', 'r') then do
  do while ~eof(pfile)
    inln = readln(pfile)
    if inln ~= "" then do
      wstr = upper(word(inln, 1))
      if wstr = "USEREQ" then
        usereq = 1
      else if wstr = "NOUSEREQ" then
        usereq = 0
      else if wstr = "PUBSCREEN" then
        PSCR = strip(delstr(inln, 1, length(wstr)), 'b', ' "')
      else if wstr = "LINEWIDTH" then do
        wstr = word(inln, 2)
        if datatype(wstr, 'w') then plwidth = wstr
      end
    end
  end
  close(pfile)
end

if pscr = "" | (pscr ~= "WORKBENCH" & ~show('p', pscr)) then
  pscr = "SCIONGEN"
scrname = scrname||pscr

/* Command line options get priority over global settings */

if srchstr ~= "" then do
  if srchstr = "QUIET" | srchstr = "NOREQ" then do
    outval = srchstr; srchstr = ""
  end
end

if outval = "QUIET" then do
  outp = 0; usereq = 0
end
else if outval = "NOREQ" then usereq = 0

if ~show('l','rexxarplib.library') then do
  if exists('libs:rexxarplib.library') then
    call addlib('rexxarplib.library',0,-30,0)
end

screentofront(pscr)

if usereq & ~show('l','rexxreqtools.library') then do
  if exists('libs:rexxreqtools.library') then
    call addlib('rexxreqtools.library',0,-30,0)
  else do
    usereq = 0; outp = 1
    Tell("Unable to open rexxreqtools.library - using text output")
  end
end

/* Originally stolen from Peter Billing - thanks Peter ;-) */
if ~show('P','SCIONGEN') then do
  EndString('I am sorry to say that the SCION Genealogist' || NL ||,
    'database is not available. Please start the' || NL ||,
    'SCION program BEFORE using this script!')
end

/* Printer Codes (some of which are currently unused): */
ESC = '1B'x
prtinit = ESC||"#1";     /* ESC#1 initialize      */
prtundon = ESC||"[4m";   /* ESC[4m underline on   */
prtundoff = ESC||"[24m"; /* ESC[24m underline off */
prtdson = ESC||"[1m";    /* ESC[1m boldface on    */
prtdsoff = ESC||"[22m";  /* ESC[22m boldface off  */
prtnlqon = ESC||"[2"||'22'x||"z";  /* ESC[2"z NLQ on  */
prtnlqoff = ESC||"[1"||'22'x||"z"; /* ESC[1"z NLQ off */

MyPort = "SCIONGEN"
Address value MyPort
GETDBNAME
dbname = upper(RESULT)

if outp & ~usereq then do
  if pscr ~= "WORKBENCH" then do
    scrdev = 'SCNSDXSCR'
    if ~open(scrdev, scrname, 'w') then scrdev = stdout
  end
  Tell("Scion SOUNDEX script v"||versionstr||" by Freddy Ariës")
  Tell("Database: "||dbname|| NL)
end

if srchstr = '' then do
  if usereq then do
    srchname = rtgetstring(,'Enter the surname to search for: '||,
            NL,'Input Request:','_Continue','rt_pubscrname = '||PSCR)
    if srchname = '' then EXIT
  end
  else do
    TellNN("Enter the surname to search for: ")
    srchname = readln(scrdev)
  end
  srchname = upper(srchname)
end
else do
  srchname = upper(srchstr)
end

if usereq then do
  if outname = "" then do
    odev = rtezrequest('Current Scion database: '||dbname||,
      NL||'Where should the output be sent to?'||,
      NL,' _File |_Printer|_Screen|_Nowhere','Scion SOUNDEX script v'||versionstr||' by Freddy Ariës','rt_pubscrname = '||PSCR)
    select
      when odev = 1 then do
        /* We need a file requester for further data */
        dblen = length(dbname)
        if dblen>6 & right(dbname, 6)=".SCION" then
          dbname=left(dbname, dblen - 6)
        outname = rtfilerequest(,dbname||'.SDX','Output filename',,'rtfi_buffer = true   rt_pubscrname = '||PSCR||'   rtfi_initialpath = RAM:',)
        if outname = '' then
          outname = dbname||'.SDX'
      end
      when odev = 2 then
        outname = 'PRT:'
      when odev = 3 then
        outname = 'STDOUT'
      otherwise
        EXIT
        /* You selected 'Nowhere' */
    end
  end

  useirn = rtezrequest('Do you want to output the IRNs'||,
            NL||'(the record numbers) as well?'||,
            '',' _Yes| _No ','Input Request:','rt_pubscrname = '||PSCR)
end
else do
  if outname = "" then do
    Tell("Enter output file (filename with complete path, or PRT: for printer,")
    TellNN("or STDOUT for screen): ")
    outname = readln(scrdev)
    outname = strip(outname, 'b', ' "')
    if outname = "" then outname = "STDOUT"
  end

  TellNN("Do you want to output the IRNs (numbers) as well (y/n)? ")
  instr = readln(scrdev)
  instr = upper(left(instr, 1))
  Tell("")
  if instr = "Y" then useirn = 1
  else useirn = 0
end

/* convert the entered string to a SOUNDEX search pattern */
spat = GetSoundex(srchname)
if spat = 'A' then do
  EndString("Unable to create soundex code for name string!")
end

/* Make a list of all the people in the database whose surname matches
 * the given lastname (ie. matching soundex codes)
 */

OpenPrinter()

GETTOTALIRN
TotalIRN = RESULT
do i = 1 to TotalIRN
  EXISTPERSON i
  if RESULT = 'YES' then
  do
    GETLASTNAME i
    lname = upper(RESULT)
    ccode = GetSoundex(lname)
    if ccode = spat then do
      /* Found a match - output the name */
      GETFIRSTNAME i
      fnames = RESULT
      if useirn then
    oline = left(i||".     ",6)
      else
        oline = ""
      oline = oline||lname||", "||fnames
      writeln(prtdev, oline)
    end
  end
end

writeln(prtdev, prtnlqoff); /* ESC[1"z NLQ off */

EndString("Done.")
EXIT

/* Some special purpose routines for Soundex */

GetSoundex: PROCEDURE EXPOSE sxlen
parse arg nstr
  found = 0
  wstr = upper(nstr)

  ix = 1; wix = 0; wval = 0
  wlen = length(wstr)
  code = 'A';

  /* Find first letter from the string */
  do while ~found & (wix < wlen)
    wix = wix + 1
    c = substr(wstr,wix,1)
    if c >= 'A' & c <= 'Z' then do
      found = 1
      code = c
    end
    else if c = ',' then wix = wlen
    /* Everything after a comma is skipped - for now.
     * The assumption is made that everything after a comma is prefixes.
     * eg. Von Hoesen can be stored as "Von Hoesen", or as "Hoesen, Von"
     * In the first case, it will become "V525", in the 2nd "H250"
     */
  end
  if ~found then return code
  pv = GetValue(code)

  /* Append a 3-digit (sxlen-size) code to the letter */
  do while ix <= sxlen & wix < wlen
    wix = wix + 1
    wval = GetValue(substr(wstr,wix,1))
    if wval > 0 & wval ~= pv then do
      code = code||wval
      pv = wval
      ix = ix + 1
    end
    else if wval ~= pv then pv = ''
  end

  do while ix <= sxlen
    code = code||"0"
    ix = ix + 1
  end
return code

GetValue: PROCEDURE
parse arg c
  if c = 'B' | c = 'F' | c = 'P' | c = 'V' then return 1
  if c = 'C' | c = 'G' | c = 'J' | c = 'K' | c = 'Q' | c = 'S' | c = 'X' | c = 'Z' then return 2
  if c = 'D' | c = 'T' then return 3
  if c = 'L' then return 4
  if c = 'M' | c = 'N' then return 5
  if c = 'R' then return 6

return 0

/* General purpose requesters */

OpenPrinter:
/* Open the printer device and print out a nice header */
if outname = "STDOUT" then
  prtdev = scrdev
else do
  prtdev = 'PRINTER'
  if ~open(prtdev, outname, 'w') then
    EndString("ERROR: Failed to open output file!")
end
writeln(prtdev, prtinit||prtnlqon)
prtstr = prtundon||prtdson||"SOUNDEX listing for "||srchname||" (Soundex code: "||spat||")"||prtdsoff||prtundoff
writeln(prtdev, prtstr)
prtstr = prtdson||"Report printed on: "||date()||"        "||"database: "||dbname||prtdsoff
writeln(prtdev, prtstr)
prtstr = copies('=', plwidth)
writeln(prtdev, prtstr)
return 0

Tell: PROCEDURE EXPOSE outp scrdev
parse arg str
if outp then
  writeln(scrdev, str)
return 0

TellNN: PROCEDURE EXPOSE outp scrdev
parse arg str
if outp then
  writech(scrdev, str)
return 0

EndString: PROCEDURE EXPOSE outp prtdev usereq scrdev pscr
parse arg str
/* If you turned off stdout, no error messages will be shown! */
if usereq then
  rtezrequest(str,'E_xit','Soundex Message:','rt_pubscrname = '||PSCR)
else do
  Tell(str || '0A'x)
end
if outp & ~usereq & (scrdev ~= stdout) then do
  Tell("Press <return> to exit.")
  readln(scrdev)
  close(scrdev)
end
close(prtdev)
EXIT

/* Let's make sure you get a nice message when you turn off the printer :-) */

IOERR:
bline = SIGL
say "I/O error #"||RC||" detected in line "||bline||":"
say sourceline(bline)
EXIT