home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #3 / amigamamagazinepolishissue1998.iso / bazy / scion407 / scionarexx.lha / Scion2GEDCOM.rexx < prev    next >
OS/2 REXX Batch file  |  1995-06-01  |  16KB  |  556 lines
  1. /****************************************************************************
  2.  *                                                                          *
  3.  * $VER: Scion2GEDCOM 2.11 (23 May 1995)
  4.  *                                                                          *
  5.  *                      Written by Freddy Ariës                             *
  6.  *                                                                          *
  7.  * This program was created to export the Scion data into the GEDCOM file   *
  8.  * format. It is still very basic.                                          *
  9.  *                                                                          *
  10.  * This version uses (by default) the rexxreqtools.library (which requires  *
  11.  * a version of reqtools larger than 2.0 and rexxsyslib.library)            *
  12.  * If you do not have these, you need to supply the NOREQ argument (for     *
  13.  * Shell output), or the QUIET argument (for no output at all).             *
  14.  *                                                                          *
  15.  * Dates should be in English, and in the format "DD MMM YYYY",             *
  16.  * "DD-MMM-YYYY" or "DD.MMM.YYYY", if you don't want any problems with      *
  17.  * programs importing the GEDCOM data.                                      *
  18.  * The database must be running for this AREXX script to work.              *
  19.  *                                                                          *
  20.  * New (requested by Robbie): progress indicator, using rexxarplib.library  *
  21.  *                                                                          *
  22.  * TO DO (don't expect it anytime soon, though):                            *
  23.  *  - Try to enforce the date format "DD MMM YYYY" [?]                      *
  24.  *  - Parsing for ABT, ABOUT, BEF, BEFORE, AFT, AFTER                       *
  25.  *  - If date or place ends with a '?', remove the questionmark and add a   *
  26.  *    QUAY 1 to the data.                                                   *
  27.  *  ? Reorganize the database                                               *
  28.  *                                                                          *
  29.  ****************************************************************************/
  30.  
  31. options failat 20; options results
  32. arg outname outval
  33.  
  34. versionstr = "2.11"
  35. usereq = 1; /* change this to 0 if you don't want to use reqtools */
  36. prgrs = 1; pgopen = 0; /* use RexxArp progress indicator */
  37.   /* change prgrs to 0 for not using it */
  38. outp = 1; output = stdout
  39. NL = '0A'x
  40.  
  41. signal on IOERR
  42.  
  43. /* parse command line options, to enable calling the script automatically,
  44.  * eg. from a function key
  45.  */
  46.  
  47. do while outname = '?'
  48.   writeln(stdout, "OUTFILE/A,QUIET/S,NOREQ/S ")
  49.   pull outname outval
  50. end
  51.  
  52. if outname ~= "" then do
  53.   if outname = "QUIET" | outname = "NOREQ" then do
  54.     outval = outname; outname = ""
  55.   end
  56. end
  57.  
  58. if outval = "QUIET" then do
  59.   outp = 0; usereq = 0; prgrs = 0
  60. end
  61. else if outval = "NOREQ" then do
  62.   usereq = 0; prgrs = 0
  63. end
  64.  
  65. if usereq & ~show('l','rexxreqtools.library') then do
  66.   if exists('libs:rexxreqtools.library') then
  67.     call addlib('rexxreqtools.library',0,-30,0)
  68.   else do
  69.     usereq = 0; outp = 1
  70.     Tell("Unable to open rexxreqtools.library - using text output")
  71.   end
  72. end
  73.  
  74. if ~usereq then prgrs = 0
  75.  
  76. if prgrs & ~show('l','rexxarplib.library') then do
  77.   if exists('libs:rexxarplib.library') then
  78.     call addlib('rexxarplib.library',0,-30,0)
  79.   else
  80.     prgrs = 0
  81. end
  82.  
  83. /* These first few lines are stolen from Peter Billings - thanks Peter ;-) */
  84. if ~show('P','SCIONGEN') then do
  85.   TermError('I am sorry to say that the SCION Genealogist' || NL ||,
  86.     'database is not available. Please start the' || NL ||,
  87.     'SCION program BEFORE using this script!')
  88. end
  89.  
  90. MyPort = "SCIONGEN"
  91. Address value MyPort
  92. GETDBNAME
  93. dbname = upper(RESULT)
  94.  
  95. if outp & ~usereq then do
  96.   Tell("Scion to GEDCOM conversion script v"||versionstr||" by Freddy Ariës")
  97.   Tell("Database: "||dbname|| NL)
  98. end
  99.  
  100. /* It's a good habit to add the ".scion" extension to Scion database files */
  101. dblen = length(dbname)
  102. if dblen>6 & right(dbname, 6)=".SCION" then dbname=left(dbname, dblen - 6)
  103.  
  104. if outname = "" then do
  105.   if outp then do
  106.     if usereq then do
  107.       odev = rtezrequest('Current Scion database: '||dbname||,
  108.        NL||'Where should the GEDCOM output be sent to?'||,
  109.        NL,' _File |_Printer|_Screen|_Nowhere','Scion to GEDCOM v'||versionstr||' by Freddy Ariës','rt_pubscrname = SCIONGEN')
  110.       select
  111.         when odev = 1 then do
  112.           /* We need a file requester for further data */
  113.           outname = rtfilerequest(,dbname||'.GED','Output filename',,'rtfi_buffer = true   rt_pubscrname = SCIONGEN   rtfi_initialpath = RAM:',)
  114.           if outname = '' then
  115.             outname = dbname||'.GED'
  116.         end
  117.         when odev = 2 then
  118.           outname = 'PRT:'
  119.         when odev = 3 then
  120.           outname = 'STDOUT'
  121.         otherwise
  122.           EXIT
  123.           /* You selected 'Nowhere' */
  124.       end
  125.     end
  126.     else do
  127.       Tell("Enter output file (filename with complete path, or PRT: for printer,")
  128.       TellNN("or STDOUT for screen): ")
  129.       pull outname
  130.       Tell("Destination: "||outname)
  131.       TellNN("Continue (y/n)? ")
  132.       pull conf
  133.       /* Note that left works on empty strings ("") too! */
  134.       if left(conf,1) ~= "Y" then do
  135.         Tell("Goodbye...")
  136.         EXIT
  137.       end
  138.       Tell("")
  139.     end
  140.   end
  141.   else
  142.     outname = "RAM:"dbname".GED"
  143.     /* If we're not allowed to use stdout, default to this filename */
  144. end
  145.  
  146. if outname ~= "STDOUT" then do
  147.   output = 'OUTPUT'
  148.   if ~open(output, outname, "w") then
  149.     TermError("ERROR: Unable to open output file.")
  150. end
  151.  
  152. if ~usereq then
  153.   Tell("Be patient - this may take a while...")
  154.  
  155. GETPROGVERSION
  156. prgvers = RESULT
  157.  
  158. writeln(output, "0 HEAD")
  159. writeln(output, "1 SOUR SCION_AMIGA")
  160. writeln(output, "2 NAME Scion Genealogist")
  161. writeln(output, "2 VERS "||prgvers)
  162. writeln(output, "2 CORP Robbie J. Akins")
  163. writeln(output, "3 ADDR 5 Austin Street, Wellington 6001, New Zealand")
  164.  
  165. str = "1 DATE" upper(date())
  166. writeln(output, str)
  167. writeln(output, "1 @S1@ SUBM")
  168. str = "1 FILE" dbname
  169. writeln(output, str)
  170. writeln(output, "1 GEDC")
  171. writeln(output, "2 VERS 5.3")
  172.  
  173. if prgrs then do
  174.   Postmsg(10, 10, "Scion to GEDCOM (by Freddy Ariës)\Database: "||dbname||"\Processing person:\ ", "SCIONGEN")
  175.   pgopen = 1
  176. end
  177.  
  178. GETTOTALIRN
  179. TotalIRN = RESULT
  180. do i = 1 to TotalIRN
  181.   if pgopen then Postmsg(,,"\\\"||i||" (of "||TotalIRN||")", "SCIONGEN")
  182.   EXISTPERSON i
  183.   if RESULT = 'YES' then
  184.   do
  185.     str = "0 @I"i"@ INDI"
  186.     writeln(output, str)
  187.     GETFIRSTNAME i
  188.     fnames = RESULT
  189.     GETLASTNAME i
  190.     lname = RESULT
  191.     str = "1 NAME "fnames"/"lname"/"
  192.     writeln(output, str)
  193.     GETSEX i
  194.     sx = RESULT
  195.     if sx ~= "M" then do
  196.      sx = "F"
  197.     end
  198.     str = "1 SEX" sx
  199.     writeln(output, str)
  200.     GETBIRTHDATE i
  201.     datestr = ParseDate(upper(RESULT))
  202.     GETBIRTHPLACE i
  203.     placestr = RESULT
  204.     if datestr ~= "" | placestr ~= "" then do
  205.       writeln(output, "1 BIRT")
  206.       if datestr ~= "" then do
  207.         str = "2 DATE" datestr
  208.         writeln(output, str)
  209.       end
  210.       if placestr ~= "" then do
  211.         str = "2 PLAC" placestr
  212.         writeln(output, str)
  213.       end
  214.     end
  215.     GETBAPTISMDATE i
  216.     datestr = ParseDate(upper(RESULT))
  217.     GETBAPTISMPLACE i
  218.     placestr = RESULT
  219.     if datestr ~= "" | placestr ~= "" then do
  220.       writeln(output, "1 BAPM")
  221.       if datestr ~= "" then do
  222.         str = "2 DATE" datestr
  223.         writeln(output, str)
  224.       end
  225.       if placestr ~= "" then do
  226.         str = "2 PLAC" placestr
  227.         writeln(output, str)
  228.       end
  229.     end
  230.     GETDEATHDATE i
  231.     datestr = ParseDate(RESULT)
  232.     GETDEATHPLACE i
  233.     placestr = RESULT
  234.     GETDIEDOF i
  235.     diedofstr = RESULT
  236.     if datestr ~= "" | placestr ~= "" | diedofstr ~= "" then do
  237.       writeln(output, "1 DEAT")
  238.       if datestr ~= "" then do
  239.     str = "2 DATE" datestr
  240.     writeln(output, str)
  241.       end
  242.       if placestr ~= "" then do
  243.     str = "2 PLAC" placestr
  244.     writeln(output, str)
  245.       end
  246.       if datestr ~= "" then do
  247.     str = "2 CAUS" diedofstr
  248.     writeln(output, str)
  249.       end
  250.     end
  251.     GETBURIALDATE i
  252.     datestr = ParseDate(RESULT)
  253.     GETBURIALPLACE i
  254.     placestr = RESULT
  255.     if datestr ~= "" | placestr ~= "" then do
  256.       writeln(output, "1 BURI")
  257.       if datestr ~= "" then do
  258.     str = "2 DATE" datestr
  259.     writeln(output, str)
  260.       end
  261.       if placestr ~= "" then do
  262.     str = "2 PLAC" placestr
  263.     writeln(output, str)
  264.       end
  265.     end
  266.     GETOCCUPATION i
  267.     rs1 = RESULT
  268.     if rs1 ~= "" then do
  269.       str = "1 OCCU" rs1
  270.       writeln(output, str)
  271.     end
  272.     GETEDUCATION i
  273.     rs1 = RESULT
  274.     if rs1 ~= "" then do
  275.       str = "1 EDUC" rs1
  276.       writeln(output, str)
  277.     end
  278.     GETRELIGION i
  279.     rs1 = RESULT
  280.     if rs1 ~= "" then do
  281.       str = "1 RELI" rs1
  282.       writeln(output, str)
  283.     end
  284.     GETPERSCOMMENT i
  285.     rs1 = RESULT
  286.     GETPERSREFS i
  287.     rs2 = RESULT
  288.     if rs1 ~= "" then do
  289.       str = "1 NOTE" rs1
  290.       writeln(output, str)
  291.     end
  292.     else if rs2 ~= "" then do
  293.       /* We need some way to separate the Comments data from the
  294.        * References data - (ab)use the NOTE and CONT fields for that
  295.        */
  296.       str = "1 NOTE -"
  297.       writeln(output, str)
  298.     end
  299.     if rs2 ~= "" then do
  300.       str = "2 CONT" rs2
  301.       writeln(output, str)
  302.     end
  303.     GETPARENTS i
  304.     ParFGRN = RESULT
  305.     EXISTFAMILY ParFGRN
  306.     if RESULT = 'YES' then do
  307.       str = "1 FAMC @F"ParFGRN"@"
  308.       writeln(output, str)
  309.     end
  310.     HuwNum = 0
  311.     GETMARRIAGE i HuwNum
  312.     MarrFGRN = RESULT
  313.     do while MarrFGRN ~= ""
  314.       EXISTFAMILY MarrFGRN
  315.       if RESULT = 'YES' then do
  316.         str = "1 FAMS @F"MarrFGRN"@"
  317.         writeln(output, str)
  318.       end
  319.       HuwNum = HuwNum + 1
  320.       GETMARRIAGE i HuwNum
  321.       MarrFGRN = RESULT
  322.     end
  323.   end
  324. end
  325. if ~usereq then
  326.   Tell("Number of persons output: "||TotalIRN)
  327.  
  328. /* Now the list of families... */
  329.  
  330. if pgopen then Postmsg(,, "\\Processing family:\ ", "SCIONGEN")
  331.   
  332. GETTOTALFGRN
  333. TotalFGRN = Result
  334. do i = 1 to TotalFGRN
  335.   if pgopen then Postmsg(,, "\\\"||i||" (of "||TotalFGRN||")", "SCIONGEN")
  336.   EXISTFAMILY i
  337.   if RESULT = 'YES' then do
  338.     str = "0 @F"i"@ FAM"
  339.     writeln(output, str)
  340.     GETPRINCIPAL i
  341.     husb = RESULT
  342.     if husb ~= "" then do
  343.       EXISTPERSON husb
  344.       if RESULT = 'YES' then do
  345.     GETSEX husb
  346.     hsx = RESULT
  347.     /* Note: GEDCOM requires 1 husband (male) and 1 wife (female).
  348.      * Scion allows more unconventional matings as well, so we have
  349.      * to improvise a bit here, and hope the receiving program isn't
  350.      * too strict...
  351.      */
  352.     if hsx = "M" then do
  353.       str = "1 HUSB @I"husb"@"
  354.       writeln(output, str)
  355.       GETSPOUSE i
  356.       wife = RESULT
  357.       if wife ~= "" then do
  358.         EXISTPERSON wife
  359.         if RESULT = 'YES' then do
  360.           /* The principal is male; assume the partner is female */
  361.           str = "1 WIFE @I"wife"@"
  362.           writeln(output, str)
  363.         end
  364.       end    
  365.     end
  366.     else do
  367.       /* The principal isn't male - define the partner as male
  368.          and the principal as female
  369.        */
  370.       if hsx ~= "F" then do
  371.             if usereq then
  372.           rtezrequest('WARNING: Unrecognized Sex for Principal'||NL||,
  373.                 'Sex was:'||hsx||'. Assuming FEMALE!','_Continue','Converter Message:','rt_pubscrname = SCIONGEN')
  374.             else
  375.           Tell("WARNING: Unrecognized Sex for Principal ("||hsx||") - assuming FEMALE")
  376.       end
  377.       GETSPOUSE i
  378.       wife = RESULT
  379.       if wife ~= "" then do
  380.         EXISTPERSON wife
  381.         if RESULT = 'YES' then do
  382.           GETSEX wife
  383.           hsx = RESULT
  384.           if hsx ~= "M" then do
  385.             if usereq then
  386.               rtezrequest('WARNING: No male partner in family!','_Continue','Converter Message:','rt_pubscrname = SCIONGEN')
  387.                 else
  388.           Tell("WARNING: No male partner in family!")
  389.               end
  390.           str = "1 HUSB @I"wife"@"
  391.           writeln(output, str)
  392.         end
  393.       end
  394.       str = "1 WIFE @I"husb"@"
  395.       writeln(output, str)
  396.     end
  397.       end
  398.     end
  399.     GETENGAGEDATE i
  400.     datestr = ParseDate(RESULT)
  401.     GETENGAGEPLACE i
  402.     placestr = RESULT
  403.     if datestr ~= "" | placestr ~= "" then do
  404.       writeln(output, "1 ENGA")
  405.       if datestr ~= "" then do
  406.         str = "2 DATE" datestr
  407.     writeln(output, str)
  408.       end
  409.       if placestr ~= "" then do
  410.     str = "2 PLAC" placestr
  411.     writeln(output, str)
  412.       end
  413.     end
  414.     datestr = ""; placestr = ""
  415.     GETMARRYDATE i
  416.     datestr = ParseDate(RESULT)
  417.     GETMARRYPLACE i
  418.     placestr = RESULT
  419.     GETCELEBRANT
  420.     clbrnt = RESULT
  421.     if datestr ~= "" | placestr ~= "" | clbrnt ~= "" then do
  422.       writeln(output, "1 MARR")
  423.       if datestr ~= "" then do
  424.         str = "2 DATE" datestr
  425.     writeln(output, str)
  426.       end
  427.       if placestr ~= "" then do
  428.     str = "2 PLAC" placestr
  429.     writeln(output, str)
  430.       end
  431.       if clbrnt ~= "" then do
  432.     str = "2 OFFI" clbrnt
  433.     writeln(output, str)
  434.       end
  435.     end
  436.     /* TO DO: At the moment, GETENDING returns a localized string ! */
  437.     /* But this script assumes that numbers are returned */
  438.     GETENDING i
  439.     endstr = RESULT
  440.     if endstr = "2" | endstr = "3" | endstr = "4" then do
  441.       if endstr = "2" then do
  442.         writeln(output, "1 DIV")
  443.         writeln(output, "2 TYPE DIVORCED")
  444.       end
  445.       else if endstr = "3" then do
  446.         writeln(output, "1 DIV")
  447.         writeln(output, "2 TYPE SEPARATED")
  448.       end
  449.       else if endstr = "4" then
  450.         writeln(output, "1 ANUL")
  451.       datestr = ""; placestr = ""
  452.       GETENDDATE i
  453.       datestr = ParseDate(RESULT)
  454.       if datestr ~= "" then do
  455.         str = "2 DATE" datestr
  456.     writeln(output, str)
  457.       end
  458.       GETENDPLACE i
  459.       placestr = RESULT
  460.       if placestr ~= "" then do
  461.     str = "2 PLAC" placestr
  462.     writeln(output, str)
  463.       end
  464.       /* TO DO: how do we convert an enddate/place caused by death ? */
  465.     end
  466.     GETFAMREFS i
  467.     rs1 = RESULT
  468.     GETFAMCOMMENT i
  469.     rs2 = RESULT
  470.     if rs2 ~= "" then do
  471.       str = "1 NOTE" rs2
  472.       writeln(output, str)
  473.     end
  474.     else if rs1 ~= "" then do
  475.       /* We need some way to separate the Reference data from the
  476.        * Comments data - (ab)use the NOTE and CONT fields for that
  477.        */
  478.       str = "1 NOTE -"
  479.       writeln(output, str)
  480.     end
  481.     if rs1 ~= "" then do
  482.       str = "2 CONT" rs1
  483.       writeln(output, str)
  484.     end
  485.  
  486.     ChNum = 0
  487.     GETCHILD i ChNum
  488.     ChIRN = RESULT
  489.     do while ChIRN ~= ""
  490.       EXISTPERSON ChIRN
  491.       if RESULT = 'YES' then do
  492.         str = "1 CHIL @I"ChIRN"@"
  493.         writeln(output, str)
  494.       end
  495.       ChNum = ChNum + 1
  496.       GETCHILD i ChNum
  497.       ChIRN = RESULT
  498.     end
  499.     /* optional:
  500.        str = "1 NCHI" ChNum
  501.        writeln(output, str)
  502.      */
  503.   end
  504. end
  505. if pgopen then do
  506.   Postmsg()
  507.   pgopen = 0
  508. end
  509. if usereq then
  510.   rtezrequest('Conversion done.'||NL||'Number of persons output: '||TotalIRN||,
  511.     NL||'Number of families output: '||TotalFGRN||NL,'_Continue','Converter Message:','rt_pubscrname = SCIONGEN')
  512. else
  513.   Tell("Number of families output: "||TotalFGRN)
  514.  
  515. writeln(output, "0 TRLR")
  516. close('OUTPUT')
  517. EXIT
  518.  
  519. ParseDate: PROCEDURE
  520. parse arg datestr
  521.  
  522. /* optional: remove leading zero's */
  523. /* replace all "-" or "." in the date by " " */
  524. datestr = upper(translate(datestr,'  ','-.'))
  525. return datestr
  526.  
  527. Tell: PROCEDURE EXPOSE outp
  528. parse arg str
  529. if outp then writeln(stdout, str)
  530. return 0
  531.  
  532. TellNN: PROCEDURE EXPOSE outp
  533. parse arg str
  534. if outp then writech(stdout, str)
  535. return 0
  536.  
  537. TermError: PROCEDURE EXPOSE outp output usereq pgopen
  538. parse arg str
  539. if pgopen then Postmsg()
  540. /* If you turned off stdout, no error messages will be shown! */
  541. if usereq then
  542.   rtezrequest(str,'E_xit','Converter Message:','rt_pubscrname = SCIONGEN')
  543. else
  544.   Tell(str || '0A'x)
  545. close(output)
  546. EXIT
  547.  
  548. /* Let's make sure you get a nice message when you turn off the printer :-) */
  549.  
  550. IOERR:
  551.   bline = SIGL
  552.   say "I/O error #"||RC||" detected in line "||bline||":"
  553.   say sourceline(bline)
  554.   if pgopen then Postmsg()
  555.   EXIT
  556.