home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #3
/
amigamamagazinepolishissue1998.iso
/
bazy
/
scion407
/
scionarexx.lha
/
Soundex.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1995-07-01
|
8KB
|
285 lines
/****************************************************************************
* *
* $VER: Soundex 1.00 (3 Feb 1995)
* *
* Written by Freddy Ariës *
* *
* Program for Scion Genealogist 4.0 and above (no guarantees are given *
* for lower versions). This program should ask the user for a (last)name, *
* 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. *
* *
* For those who don't know what SOUNDEX is, it is a search method that *
* looks for persons based on the way their surname sounds, rather than *
* the way it is spelled. *
* *
****************************************************************************/
options failat 20; options results
arg srchstr outname outval
versionstr = "1.00"
usereq = 1; /* change this to 0 if you don't want to use reqtools */
outp = 1; output = stdout
NL = '0A'x
plwidth = 78; /* linewidth of the printer */
sxlen = 3; /* the length of the soundex-code is usually 3,
* but if you insist, you can use a longer code
*/
signal on IOERR
/* parse command line options, to enable calling the script automatically,
* eg. from a function key
*/
do while srchstr = '?'
writeln(stdout, "SEARCHNAME/A,OUTFILE/A,QUIET/S,NOREQ/S ")
pull srchstr outname outval
end
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 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
/* These first few lines are stolen from Peter Billings - thanks Peter ;-) */
if ~show('P','SCIONGEN') then do
TermError('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
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
srchname = upper(srchname)
end
else do
TellNN("Enter the surname to search for: ")
pull srchname
end
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): ")
pull outname
if outname = "" then
outname = "STDOUT"
end
TellNN("Do you want to output the IRNs (numbers) as well (y/n)? ")
pull instr
Tell("")
if left(instr, 1) = "Y" then useirn = 1
else useirn = 0
end
/* convert the entered string to a SOUNDEX search pattern */
spat = GetSoundex(srchname)
/* 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 */
close(prtdev)
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
end
if ~found then return 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 then do
code = code||wval
ix = ix + 1
end
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 = stdout
else do
prtdev = 'PRINTER'
if ~open(prtdev, outname, 'w') then
TermError("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
parse arg str
if outp then
writeln(stdout, str)
return 0
TellNN: PROCEDURE EXPOSE outp
parse arg str
if outp then
writech(stdout, str)
return 0
TermError: PROCEDURE EXPOSE outp prtdev usereq 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
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