Amiga Format CD 2/amigaformatcd02.iso/demos/cdgallery/aga2/rexx/unrelated.rexx

OS/2 REXX Batch file | 1996-05-20 | 5.5 KB | 185 lines

/****************************************************************************
 *                                                                          *
 * $VER: Unrelated 1.01 (18 Jul 1995)
 *                                                                          *
 *                      Written by Robbie Akins                             *
 *                                                                          *
 * Adapted from ARexx scripts by Freddy Ariës - Many thanks Freddy :-)      *
 *                                                                          *
 * ARexx script to find "unrelated" people in the database.                 *
 * That is, it will locate all those people who have no parents and who     *
 * have no marriages recorded (and hence cannot have any recorded children) *
 *                                                                          *
 * 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, change the line 'usereq = 1' to 'usereq = 0'   *
 *                                                                          *
 *                                                                          *
 ****************************************************************************/

options results
arg outname outval

versionstr = "1.01"
usereq = 1; /* change this to 0 if you don't want to use reqtools */
outp = 1; output = stdout
NL = '0A'x

signal on IOERR

/* parse command line options, to enable calling the script automatically,
 * eg. from a function key
 */

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

if outname ~= "" then do
  if outname = "QUIET" | outname = "NOREQ" then do
    outval = outname; outname = ""
  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 were 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

myport = "SCIONGEN"
address value myport
GETDBNAME
dbname = upper(RESULT)

CurrIRN = 1

if outp & ~usereq then do
  Tell("Scion Unrelated Person Finder v"||versionstr||" by Robbie Akins")
  Tell("Current Scion database: "||dbname)
end

GETTOTALIRN
TotalIRN = RESULT
if  TotalIRN = 0 then EXIT    /* No database to work on! */

/* It's a good habit to add an ".UNREL" extension to "unrelated" files */
dblen = length(dbname)
if dblen>6 & right(dbname, 6)=".Scion" then dbname=left(dbname, dblen - 6)

if outname = "" then do
  if outp then do
    if usereq then do
       odev = rtezrequest('Current Scion database: '||dbname||,
       NL||'Where should the output be sent to?'||,
       NL,' _File |_Printer|_Screen|_Nowhere','Unrelated People v'||versionstr||' by Robbie Akins','rt_pubscrname = SCIONGEN')

      select
        when odev = 1 then do
          /* We need a file requester for further data */
          outname = rtfilerequest(,dbname||'.UNREL','Output filename',,'rtfi_buffer = true   rt_pubscrname = SCIONGEN   rtfi_initialpath = RAM:',)
          if outname = '' then
            outname = dbname||'.UNREL'
        end
        when odev = 2 then
          outname = 'PRT:'
        when odev = 3 then
          outname = 'STDOUT'
        otherwise
          EXIT
          /* You selected 'Nowhere' */
      end
    end
    else do
      Tell("Enter output file (filename with complete path, or PRT: for printer,")
      TellNN("or STDOUT for screen): ")
      pull outname
      Tell("Destination: "||outname)
      TellNN("Continue (y/n)? ")
      pull conf
      /* Note that left works on empty strings ("") too! */
      if left(conf,1) ~= "Y" then do
        Tell("Goodbye...")
        EXIT
      end
      Tell("")
    end
  end
  else
    outname = "RAM:"dbname".UNREL"
    /* If we're not allowed to use stdout, default to this filename */
end

if outname ~= "STDOUT" then do
  output = 'OUTPUT'
  if ~open(output, outname, "w") then
    TermError("ERROR: Unable to open output file.")
end

writeln(output, "List of unrelated people:")
do while CurrIRN <= TotalIRN
    EXISTPERSON CurrIRN
        if RESULT = 'YES' then do
        GETNUMMARRY CurrIRN
        if RESULT = 0 then do
            /* No marriages. Possible candidate */
            GETPARENTS CurrIRN
            if RESULT = '' then do
            /* This person is unrelated */
            GETLASTNAME CurrIRN
            last = result
            GETFIRSTNAME CurrIRN
            first = result
            str = "IRN" CurrIRN": "Last", "First
            writeln(output, str)
        end
        end
    end
  CurrIRN = CurrIRN + 1    /* Do next possible person */
end

EXIT

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 output usereq
parse arg str
/* If you turned off stdout, no error messages will be shown! */
if usereq then
  rtezrequest(str,'E_xit','Finder Message:','rt_pubscrname = SCIONGEN')
else do
  Tell(str || '0A'x)
end
close(output)
EXIT

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