home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #3 / amigamamagazinepolishissue1998.iso / bazy / scion407 / scionarexx.lha / Soundex.rexx < prev    next >
OS/2 REXX Batch file  |  1995-07-01  |  8KB  |  285 lines
  1. /****************************************************************************
  2.  *                                                                          *
  3.  * $VER: Soundex 1.00 (3 Feb 1995)
  4.  *                                                                          *
  5.  *                      Written by Freddy Ariës                             *
  6.  *                                                                          *
  7.  * Program for Scion Genealogist 4.0 and above (no guarantees are given     *
  8.  * for lower versions). This program should ask the user for a (last)name,  *
  9.  * and output the list of names in the current Scion database that match    *
  10.  * the entered name, using the SOUNDEX method of name comparison.           *
  11.  * Scion Genealogist must be running for this script to work.               *
  12.  *                                                                          *
  13.  * For those who don't know what SOUNDEX is, it is a search method that     *
  14.  * looks for persons based on the way their surname sounds, rather than     *
  15.  * the way it is spelled.                                                   *
  16.  *                                                                          *
  17.  ****************************************************************************/
  18.  
  19. options failat 20; options results
  20. arg srchstr outname outval
  21.  
  22. versionstr = "1.00"
  23. usereq = 1; /* change this to 0 if you don't want to use reqtools */
  24. outp = 1; output = stdout
  25. NL = '0A'x
  26. plwidth = 78;  /* linewidth of the printer */
  27. sxlen = 3;  /* the length of the soundex-code is usually 3,
  28.          * but if you insist, you can use a longer code
  29.          */    
  30.  
  31. signal on IOERR
  32.  
  33. /* parse command line options, to enable calling the script automatically,
  34.  * eg. from a function key
  35.  */
  36.  
  37. do while srchstr = '?'
  38.   writeln(stdout, "SEARCHNAME/A,OUTFILE/A,QUIET/S,NOREQ/S ")
  39.   pull srchstr outname outval
  40. end
  41.  
  42. if srchstr ~= "" then do
  43.   if srchstr = "QUIET" | srchstr = "NOREQ" then do
  44.     outval = srchstr; srchstr = ""
  45.   end
  46. end
  47.  
  48. if outval = "QUIET" then do
  49.   outp = 0; usereq = 0
  50. end
  51. else if outval = "NOREQ" then usereq = 0
  52.  
  53. if usereq & ~show('l','rexxreqtools.library') then do
  54.   if exists('libs:rexxreqtools.library') then
  55.     call addlib('rexxreqtools.library',0,-30,0)
  56.   else do
  57.     usereq = 0; outp = 1
  58.     Tell("Unable to open rexxreqtools.library - using text output")
  59.   end
  60. end
  61.  
  62. /* These first few lines are stolen from Peter Billings - thanks Peter ;-) */
  63. if ~show('P','SCIONGEN') then do
  64.   TermError('I am sorry to say that the SCION Genealogist' || NL ||,
  65.     'database is not available. Please start the' || NL ||,
  66.     'SCION program BEFORE using this script!')
  67. end
  68.  
  69. /* Printer Codes (some of which are currently unused): */
  70. ESC = '1B'x
  71. prtinit = ESC||"#1";     /* ESC#1 initialize      */
  72. prtundon = ESC||"[4m";   /* ESC[4m underline on   */
  73. prtundoff = ESC||"[24m"; /* ESC[24m underline off */
  74. prtdson = ESC||"[1m";    /* ESC[1m boldface on    */
  75. prtdsoff = ESC||"[22m";  /* ESC[22m boldface off  */
  76. prtnlqon = ESC||"[2"||'22'x||"z";  /* ESC[2"z NLQ on  */
  77. prtnlqoff = ESC||"[1"||'22'x||"z"; /* ESC[1"z NLQ off */
  78.  
  79. MyPort = "SCIONGEN"
  80. Address value MyPort
  81. GETDBNAME
  82. dbname = upper(RESULT)
  83.  
  84. if outp & ~usereq then do
  85.   Tell("Scion SOUNDEX script v"||versionstr||" by Freddy Ariës")
  86.   Tell("Database: "||dbname|| NL)
  87. end
  88.  
  89. if srchstr = '' then do
  90.   if usereq then do
  91.     srchname = rtgetstring(,'Enter the surname to search for: '||,
  92.             NL,'Input Request:','_Continue','rt_pubscrname = '||PSCR)
  93.     if srchname = '' then
  94.       EXIT
  95.     srchname = upper(srchname)
  96.   end
  97.   else do
  98.     TellNN("Enter the surname to search for: ")
  99.     pull srchname
  100.   end
  101. end
  102. else do
  103.   srchname = upper(srchstr)
  104. end
  105.  
  106. if usereq then do
  107.   if outname = "" then do
  108.     odev = rtezrequest('Current Scion database: '||dbname||,
  109.       NL||'Where should the output be sent to?'||,
  110.       NL,' _File |_Printer|_Screen|_Nowhere','Scion SOUNDEX script v'||versionstr||' by Freddy Ariës','rt_pubscrname = '||PSCR)
  111.     select
  112.       when odev = 1 then do
  113.         /* We need a file requester for further data */
  114.         dblen = length(dbname)
  115.         if dblen>6 & right(dbname, 6)=".SCION" then
  116.           dbname=left(dbname, dblen - 6)
  117.         outname = rtfilerequest(,dbname||'.SDX','Output filename',,'rtfi_buffer = true   rt_pubscrname = '||PSCR||'   rtfi_initialpath = RAM:',)
  118.         if outname = '' then
  119.           outname = dbname||'.SDX'
  120.       end
  121.       when odev = 2 then
  122.         outname = 'PRT:'
  123.       when odev = 3 then
  124.         outname = 'STDOUT'
  125.       otherwise
  126.         EXIT
  127.         /* You selected 'Nowhere' */
  128.     end
  129.   end
  130.  
  131.   useirn = rtezrequest('Do you want to output the IRNs'||,
  132.             NL||'(the record numbers) as well?'||,
  133.             '',' _Yes| _No ','Input Request:','rt_pubscrname = '||PSCR)
  134. end
  135. else do
  136.   if outname = "" then do
  137.     Tell("Enter output file (filename with complete path, or PRT: for printer,")
  138.     TellNN("or STDOUT for screen): ")
  139.     pull outname
  140.     if outname = "" then
  141.       outname = "STDOUT"
  142.   end
  143.  
  144.   TellNN("Do you want to output the IRNs (numbers) as well (y/n)? ")
  145.   pull instr
  146.   Tell("")
  147.   if left(instr, 1) = "Y" then useirn = 1
  148.   else useirn = 0
  149. end
  150.  
  151. /* convert the entered string to a SOUNDEX search pattern */
  152. spat = GetSoundex(srchname)
  153.  
  154. /* Make a list of all the people in the database whose surname matches
  155.  * the given lastname (ie. matching soundex codes)
  156.  */
  157.  
  158. OpenPrinter()
  159.  
  160. GETTOTALIRN
  161. TotalIRN = RESULT
  162. do i = 1 to TotalIRN
  163.   EXISTPERSON i
  164.   if RESULT = 'YES' then
  165.   do
  166.     GETLASTNAME i
  167.     lname = upper(RESULT)
  168.     ccode = GetSoundex(lname)
  169.     if ccode = spat then do
  170.       /* Found a match - output the name */
  171.       GETFIRSTNAME i
  172.       fnames = RESULT
  173.       if useirn then
  174.     oline = left(i||".     ",6)
  175.       else
  176.         oline = ""
  177.       oline = oline||lname||", "||fnames
  178.       writeln(prtdev, oline)
  179.     end
  180.   end
  181. end
  182.  
  183. writeln(prtdev, prtnlqoff); /* ESC[1"z NLQ off */
  184. close(prtdev)
  185. EXIT
  186.  
  187. /* Some special purpose routines for Soundex */
  188.  
  189. GetSoundex: PROCEDURE EXPOSE sxlen
  190. parse arg nstr
  191.   found = 0
  192.   wstr = upper(nstr)
  193.  
  194.   ix = 1; wix = 0; wval = 0
  195.   wlen = length(wstr)
  196.   code = 'A';
  197.  
  198.   /* Find first letter from the string */
  199.   do while ~found & (wix < wlen)
  200.     wix = wix + 1
  201.     c = substr(wstr,wix,1)
  202.     if c >= 'A' & c <= 'Z' then do
  203.       found = 1
  204.       code = c
  205.     end
  206.   end
  207.   if ~found then return code
  208.  
  209.   /* Append a 3-digit (sxlen-size) code to the letter */
  210.   do while ix <= sxlen & wix < wlen
  211.     wix = wix + 1
  212.     wval = GetValue(substr(wstr,wix,1))
  213.     if wval > 0 then do
  214.       code = code||wval
  215.       ix = ix + 1
  216.     end
  217.   end
  218.  
  219.   do while ix <= sxlen
  220.     code = code||"0"
  221.     ix = ix + 1
  222.   end
  223. return code
  224.  
  225. GetValue: PROCEDURE
  226. parse arg c
  227.   if c = 'B' | c = 'F' | c = 'P' | c = 'V' then return 1
  228.   if c = 'C' | c = 'G' | c = 'J' | c = 'K' | c = 'Q' | c = 'S' | c = 'X' | c = 'Z' then return 2
  229.   if c = 'D' | c = 'T' then return 3
  230.   if c = 'L' then return 4
  231.   if c = 'M' | c = 'N' then return 5
  232.   if c = 'R' then return 6
  233. return 0
  234.  
  235. /* General purpose requesters */
  236.  
  237. OpenPrinter:
  238. /* Open the printer device and print out a nice header */
  239. if outname = "STDOUT" then
  240.   prtdev = stdout
  241. else do
  242.   prtdev = 'PRINTER'
  243.   if ~open(prtdev, outname, 'w') then
  244.     TermError("ERROR: Failed to open output file!")
  245. end
  246. writeln(prtdev, prtinit||prtnlqon)
  247. prtstr = prtundon||prtdson||"SOUNDEX listing for "||srchname||" (Soundex code: "||spat||")"||prtdsoff||prtundoff
  248. writeln(prtdev, prtstr)
  249. prtstr = prtdson||"Report printed on: "||date()||"        "||"database: "||dbname||prtdsoff
  250. writeln(prtdev, prtstr)
  251. prtstr = copies('=', plwidth)
  252. writeln(prtdev, prtstr)
  253. return 0
  254.  
  255. Tell: PROCEDURE EXPOSE outp
  256. parse arg str
  257. if outp then
  258.   writeln(stdout, str)
  259. return 0
  260.  
  261. TellNN: PROCEDURE EXPOSE outp
  262. parse arg str
  263. if outp then
  264.   writech(stdout, str)
  265. return 0
  266.  
  267. TermError: PROCEDURE EXPOSE outp prtdev usereq PSCR
  268. parse arg str
  269. /* If you turned off stdout, no error messages will be shown! */
  270. if usereq then
  271.   rtezrequest(str,'E_xit','Soundex Message:','rt_pubscrname = '||PSCR)
  272. else do
  273.   Tell(str || '0A'x)
  274. end
  275. close(prtdev)
  276. EXIT
  277.  
  278. /* Let's make sure you get a nice message when you turn off the printer :-) */
  279.  
  280. IOERR:
  281. bline = SIGL
  282. say "I/O error #"||RC||" detected in line "||bline||":"
  283. say sourceline(bline)
  284. EXIT
  285.