The CDPD Public Domain Collection for CDTV 4/CDPD_IV.bin/utilities/misc/scion/arexx/scion2gedcom.rexx

OS/2 REXX Batch file | 1994-06-28 | 12.7 KB | 453 lines

/****************************************************************************
 *                                                                          *
 * $VER: Scion2GEDCOM 1.11 (1 Mar 1994)
 *                                                                          *
 *                      Written by Freddy Ariës                             *
 *                                                                          *
 * This program was created to export the Scion data into the GEDCOM file   *
 * format. It is still very basic and not user-friendly at all.             *
 *                                                                          *
 * This version uses (by default) the rexxreqtools.library (which requires  *
 * a version of reqtools larger than 2.0 and rexxsyslib.library)            *
 * If you do not have any of these, you need to supply the NOREQ argument,  *
 * except when you supply the QUIET argument.                               *
 *                                                                          *
 * Sexes and dates should be in the English format.                         *
 * Dates should be in the format "DD MMM YYYY", "DD-MMM-YYYY" or            *
 * "DD.MMM.YYYY", if you don't want any problems with programs importing    *
 * the GEDCOM data.                                                         *
 * The database must be running for this AREXX script to work.              *
 *                                                                          *
 * TO DO:                                                                   *
 *  - Parse last names -> Capitalize with rest lowercase                    *
 *  - Better solution for the user-defined PERSONAL and FAMILY fields       *
 *    (PERSUSER1, PERSUSER2, PERSUSER3, FAMUSER1, FAMUSER2)                 *
 *    Current solution: assume defaults                                     *
 *  - Try to enforce the date format "DD MMM YYYY"                          *
 *  - Parsing for ABT, ABOUT, BEF, BEFORE, AFT, AFTER                       *
 *  - If date or place ends with a '?', remove the questionmark and add a   *
 *    QUAY 1 to the data.                                                   *
 *  - Reorganize the database (no holes between individuals or families)    *
 *  - Indicate the use of the 8bit Amiga ASCII character set                *
 *                                                                          *
 ****************************************************************************/

options failat 20; options results
arg outname outval

versionstr = "1.11"
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 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

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

if outp & ~usereq then do
  Tell("Scion to GEDCOM conversion script v"||versionstr||" by Freddy Ariës")
  Tell("Database: "||dbname|| NL)
end

/* It's a good habit to add the ".scion" extension to Scion database 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 GEDCOM output be sent to?'||,
       NL,' _File |_Printer|_Screen|_Nowhere','Scion to GEDCOM v'||versionstr||' by Freddy Ariës')
      select
        when odev = 1 then do
          /* We need a file requester for further data */
          outname = rtfilerequest('RAM:',dbname||'.GED','Output filename')
          if outname = '' then
            outname = dbname||'.GED'
        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".GED"
    /* 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

if ~usereq then
  Tell("Be patient - this may take a while...")

GETPROGVERSION
prgvers = RESULT

writeln(output, "0 HEAD")
writeln(output, "1 SOUR SCION_AMIGA")
writeln(output, "2 NAME Scion Genealogist")
writeln(output, "2 VERS "||prgvers)
writeln(output, "2 CORP Robbie J. Akins")
writeln(output, "3 ADDR 5 Austin Street, Wellington 6001, New Zealand")

str = "1 DATE" upper(date())
writeln(output, str)
writeln(output, "1 @S1@ SUBM")
str = "1 FILE" dbname
writeln(output, str)
writeln(output, "1 GEDC")
writeln(output, "2 VERS 5.2")

GETTOTALIRN
TotalIRN = RESULT
do i = 1 to TotalIRN
  EXISTPERSON i
  if RESULT = 'YES' then
  do
    str = "0 @I"i"@ INDI"
    writeln(output, str)
    GETFIRSTNAME i
    fnames = RESULT
    GETLASTNAME i
    lname = RESULT
    str = "1 NAME "fnames"/"lname"/"
    writeln(output, str)
    GETSEX i
    sx = RESULT
    if sx ~= "M" then do
     sx = "F"
    end
    str = "1 SEX" sx
    writeln(output, str)
    GETBIRTHDATE i
    datestr = ParseDate(upper(RESULT))
    GETBIRTHPLACE i
    placestr = RESULT
    if datestr ~= "" | placestr ~= "" then do
      writeln(output, "1 BIRT")
      if datestr ~= "" then do
        str = "2 DATE" datestr
        writeln(output, str)
      end
      if placestr ~= "" then do
        str = "2 PLAC" placestr
        writeln(output, str)
      end
    end
    GETDEATHDATE i
    datestr = ParseDate(RESULT)
    GETDEATHPLACE i
    placestr = RESULT
    if datestr ~= "" | placestr ~= "" then do
      writeln(output, "1 DEAT")
      if datestr ~= "" then do
    str = "2 DATE" datestr
    writeln(output, str)
      end
      if placestr ~= "" then do
    str = "2 PLAC" placestr
    writeln(output, str)
      end
    end
    GETBURIALDATE i
    datestr = ParseDate(RESULT)
    GETBURIALPLACE i
    placestr = RESULT
    if datestr ~= "" | placestr ~= "" then do
      writeln(output, "1 BURI")
      if datestr ~= "" then do
    str = "2 DATE" datestr
    writeln(output, str)
      end
      if placestr ~= "" then do
    str = "2 PLAC" placestr
    writeln(output, str)
      end
    end
    GETPERSUSER1 i
    /* Default: "Occupation" */
    rs1 = RESULT
    if rs1 ~= "" then do
      str = "1 OCCU" rs1
      writeln(output, str)
    end
    GETPERSUSER2 i
    /* "Comments" */
    rs1 = RESULT
    GETPERSUSER3 i
    /* "References" */
    rs2 = RESULT
    if rs1 ~= "" then do
      str = "1 NOTE" rs1
      writeln(output, str)
    end
    else if rs2 ~= "" then do
      /* We need some way to separate the Comments data from the
       * References data - (ab)use the NOTE and CONT fields for that
       */
      str = "1 NOTE -"
      writeln(output, str)
    end
    if rs2 ~= "" then do
      str = "2 CONT" rs2
      writeln(output, str)
    end
    GETPARENTS i
    ParFGRN = RESULT
    EXISTFAMILY ParFGRN
    if RESULT = 'YES' then do
      str = "1 FAMC @F"ParFGRN"@"
      writeln(output, str)
    end
    HuwNum = 0
    GETMARRIAGE i HuwNum
    MarrFGRN = RESULT
    do while MarrFGRN ~= ""
      EXISTFAMILY MarrFGRN
      if RESULT = 'YES' then do
        str = "1 FAMS @F"MarrFGRN"@"
        writeln(output, str)
      end
      HuwNum = HuwNum + 1
      GETMARRIAGE i HuwNum
      MarrFGRN = RESULT
    end
  end
end
if ~usereq then
  Tell("Number of persons output: "||TotalIRN)

/* Now the list of families... */

GETTOTALFGRN
TotalFGRN = Result
do i = 1 to TotalFGRN
  EXISTFAMILY i
  if RESULT = 'YES' then do
    str = "0 @F"i"@ FAM"
    writeln(output, str)
    GETPRINCIPAL i
    husb = RESULT
    if husb ~= "" then do
      EXISTPERSON husb
      if RESULT = 'YES' then do
    GETSEX husb
    hsx = RESULT
    /* Note: GEDCOM requires 1 husband (male) and 1 wife (female).
     * Scion allows more unconventional matings as well, so we have
     * to improvise a bit here, and hope the receiving program isn't
     * too strict...
     */
    if hsx = "M" then do
      str = "1 HUSB @I"husb"@"
      writeln(output, str)
      GETSPOUSE i
      wife = RESULT
      if wife ~= "" then do
        EXISTPERSON wife
        if RESULT = 'YES' then do
          /* The principal is male; assume the partner is female */
          str = "1 WIFE @I"wife"@"
          writeln(output, str)
        end
      end
    end
    else do
      /* The principal isn't male - define the partner as male
         and the principal as female
       */
      if hsx ~= "F" then do
            if usereq then
          rtezrequest('WARNING: Unrecognized Sex for Principal'||NL||,
                'Sex was:'||hsx||'. Assuming FEMALE!','_Continue','Converter Message:')
            else
          Tell("WARNING: Unrecognized Sex for Principal ("||hsx||") - assuming FEMALE")
      end
      GETSPOUSE i
      wife = RESULT
      if wife ~= "" then do
        EXISTPERSON wife
        if RESULT = 'YES' then do
          GETSEX wife
          hsx = RESULT
          if hsx ~= "M" then do
            if usereq then
              rtezrequest('WARNING: No male partner in family!','_Continue','Converter Message:')
                else
          Tell("WARNING: No male partner in family!")
              end
          str = "1 HUSB @I"wife"@"
          writeln(output, str)
        end
      end
      str = "1 WIFE @I"husb"@"
      writeln(output, str)
    end
      end
    end
    GETMARRYDATE i
    datestr = ParseDate(RESULT)
    GETMARRYPLACE i
    placestr = RESULT
    if datestr ~= "" | placestr ~= "" then do
      writeln(output, "1 MARR")
      if datestr ~= "" then do
        str = "2 DATE" datestr
    writeln(output, str)
      end
      if placestr ~= "" then do
    str = "2 PLAC" placestr
    writeln(output, str)
      end
    end
    GETFAMUSER1 i
    /* "Celebrant" */
    rs1 = RESULT
    GETFAMUSER2 i
    /* "Comments" */
    rs2 = RESULT
    if rs2 ~= "" then do
      str = "1 NOTE" rs2
      writeln(output, str)
    end
    else if rs1 ~= "" then do
      /* We need some way to separate the Celebrant data from the
       * Comments data - (ab)use the NOTE and CONT fields for that
       */
      str = "1 NOTE -"
      writeln(output, str)
    end
    if rs1 ~= "" then do
      str = "2 CONT" rs1
      writeln(output, str)
    end

    ChNum = 0
    GETCHILD i ChNum
    ChIRN = RESULT
    do while ChIRN ~= ""
      EXISTPERSON ChIRN
      if RESULT = 'YES' then do
        str = "1 CHIL @I"ChIRN"@"
        writeln(output, str)
      end
      ChNum = ChNum + 1
      GETCHILD i ChNum
      ChIRN = RESULT
    end
    /* optional:
       str = "1 NCHI" ChNum
       writeln(output, str)
     */
  end
end
if usereq then
  rtezrequest('Conversion done.'||NL||'Number of persons output: '||TotalIRN||,
    NL||'Number of families output: '||TotalFGRN||NL,'_Continue','Converter Message:')
else
  Tell("Number of families output: "||TotalFGRN)

writeln(output, "0 TRLR")
close('OUTPUT')
EXIT

ParseDate: PROCEDURE
parse arg datestr

/* optional: remove leading zero's */
/* replace all "-" or "." in the date by " " */
datestr = upper(translate(datestr,'  ','-.'))
return datestr

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','Converter Message:')
else do
  Tell(str || '0A'x)
end
close(output)
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