Ancestry Synchronization.fh_lua--[[
@Title: Ancestry Synchronization
@Type: Standard
@Author: Mark Draper
@Contributor John Elvin
@Version: 2.6
@LastUpdated: 4 May 2026
@Licence: This plugin is copyright (c) 2026 Mark Draper and is licensed under the MIT License which
is hereby incorporated by reference (see https://pluginstore.family-historian.co.uk/fh-plugin-licence)
@Description: Produces a fixed GEDCOM export, suitable for loading into RootsMagic 11 or later for
subsequent synchronization with Ancestry. Reads RootsMagic database directly and generates
a Research Note listing all differences. Deletes Facts from RootsMagic that are
not in the current Family Historian Project. Supports a customisable subset of Facts with
standard Date and Place fields, but no comments, sources, or media. Living individuals
are excluded from the output by default but can be incorporated if required.
]]
--[[
Developed from the FHUG plugin, Family Historian - RootsMagic - Ancestry Sync
Version 1.0 (Feb 2023)
- Initial Plugin Store version.
Version 1.1 (May 2023)
- Interim fix for date phrases containing quotation characters
Version 2.0 (Jun 2023)
- New main menu with details of RM and Ancestry links
- Improved messages and reports, including link to Ancestry tree
- New Ancestry audit functions and Research Note report
- Simplified comparison of parents and spouse, so family sequence is ignored
(improved compatibility with Ancestry auditing)
- New plugin options and improved options form
- basic BMD export
- optional case sensitive place and attribute value matching (previously always enforced)
- RM backup now automatic, but only if file changed
- Unmatching names relegated to Alternate Name in RM for quicker deletion
- Now supports same-sex families and surname-first names
- Improved compatibility with RM7
- Improved handling of names
- Improved cross-reference table (sorted by RM name)
- Improved handling of date phrases for full compatibility between apps
- Improved message boxes (using IUP box, not FH function)
- Additional checks when starting to screen out invalid operation
- Now requires FH 7.0.15 or later due to changes in fhFileUtils()
Version 2.0.1 (Jun 2023)
- Fix for variability in RM options file structure
Version 2.1 (Sep 2023)
- New option to base individual selection on Ancestry Sync list
- New option to disable RM/Ancestry compatibility for GEDCOM export
- New GEDCOM export Research note
- Improved menu display that keeps previous menus visible but inactive
- Now permits export of blank names (RM can import them but not create them, so works ok)
- Added extra message to close file prior to early RM update if sex change detected
- Fixed bug that stopped parent check running (simplified code for table initialisation)
- Fixed display of surnames with punctuation characters by more selective use of overwriting
case preference (let FH do the formatting)
- Fixed bug affecting export of surname-first names (forced to given-first for RM compatibility)
- Fixed typo affecting two-female family records
Version 2.2 (Nov 2023)
- More extensive memory management to handle very large projects (>25k records)
- More detailed progress bar, kept open throughout the entire Compare or Update process
- Much faster processing of bulk changes in RM by passing records in batches and using SQL 'IN' statement
- Automatic export of only changed and related records to speed up RM Share Merge
- Improved internal processing of large datasets
Version 2.3 (Jan 2024)
- Removed support for RM7/8 following Ancestry login changes
- Various minor bug fixes and code tidying
Version 2.4 (Aug 2024)
- Fixed bug with un-named individuals
- Checks for multiple UniqueID values
- New standard format options file
- Resetting RM file with changed project name now optional
- Optional import of custom fact list
- Emulator warning
Version 2.4.1 (Aug 2024)
- Fixed bug not exporting changed family records in GEDCOM update
Version 2.5 (May 2025)
- Corrected FH/RM comparison where name has suffix
- Support for multi-monitor systems
- Checks for errors in ini file when loading
- Enhanced tool tips
Version 2.5.1 (Sep 2025)
- Updated to support RM11
Version 2.6 (May 2026)
- Modified menu form
- Remove loading old format ini file (no longer required)
- Adopted/Foster/Step parental qualifiers supported
- Simplified options with standard Ancestry domain and no RM version-specific labelling
- Export Living flag to GEDCOM file in RM syntax
- LIMIT clause for Ancestry Tree ID
- New option to inhibit partial GEDCOM export
- Uses os.tmpfile() for RM working copy to guarantee ASCII name
- reworked garbage collection and memory management
- Reports RM file corruption
- Calculates missing UniqueID values
- Checks existing UIDs for consistent format
- RM file version check and warning
]]
fhInitialise(7, 0, 15)
require('luacom')
require('fhSQL')
require('iuplua')
lfs = require('lfs')
fhu = require('fhUtils')
fhfu = require('fhFileUtils')
fhu.setIupDefaults()
FSO = luacom.CreateObject("Scripting.FileSystemObject")
-- *********************************************************************
-- Main, menu and Fact selection functions
-- *********************************************************************
function main()
-- check for emulator
if fhfu.folderExists('Z:\\bin') and fhfu.folderExists('Z:\\etc') then
local msg = 'Family Historian does not support linking to external databases via plugins when ' ..
'running on Mac or Linux systems.'
MessageBox(msg, 'OK', 'ERROR', 'Emulator Incompatibility Warning')
return
end
-- check not running in Standalone GEDCOM mode
if fhGetContextInfo('CI_APP_MODE') ~= 'Project Mode' then
local msg = 'This plugin can only be run from within a Family Historian project.'
MessageBox(msg, 'OK', 'ERROR')
return
end
-- check not an Ancestry GEDCOM export that has not been processed
local IsExport, IsProcessed = IsAuditTree()
if IsExport and not IsProcessed then
local msg = 'Project is derived from an Ancestry GEDCOM export that has not been processed by the ' ..
"plugin.\n\nReload your main project and run 'Process Ancestry GEDCOM Export File' from " ..
'the main menu to prepare the file for import into Family Historian.'
MessageBox(msg, 'OK', 'ERROR')
return
end
-- check project size
if CountIndividuals() > 2^15 then
local msg = 'This plugin may experience memory issues with very large projects. ' ..
'A future update will remedy this.'
MessageBox(msg, 'OK', 'WARNING')
end
-- check Project has complete UID set
if not IsExport and not CheckUIDs() then return end
-- get plugin options
gblOptions = GetOptions()
-- exit if user cancelled
if gblOptions == -1 then return end
-- present menu
Menu()
-- delete list of changed records if no longer valid
if not gblOptions.Unchanged then
local UpdateFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Sync Update.txt'
fhfu.deleteFile(UpdateFile)
end
-- save options prior to quitting
if gblOptions then SaveOptions() end
end
-- *********************************************************************
function Menu()
-- generate main plugin menu
-- define link elements
local lblRM = iup.label{title = 'Linked RootsMagic file:'}
local lblRMfile = iup.label{expand = 'HORIZONTAL'}
local lblRMupdated = iup.label{title = 'File last accessed:'}
local lblRMfileupdated = iup.label{expand = 'HORIZONTAL'}
local lblANC = iup.label{title = 'Linked Ancestry tree:'}
local lnkANC = iup.link{expand = 'HORIZONTAL'}
local gboxLinks = iup.gridbox{lblRM, lblRMfile, lblRMupdated, lblRMfileupdated, lblANC, lnkANC;
numdiv = 2, sizecol = -1, sizelin = -1,
gapcol = 5, gaplin = 5, margin = '10x'}
local btnSelect = iup.button{title = 'Select', padding = '10x3',
action = function(self) SelectRMFile() UpdateMenu() end,
TipBalloon = 'YES', TipBalloonTitle = 'Link RootsMagic Database',
TipBalloonTitleIcon = '1',
tip = 'Select RootsMagic file linked to this project'}
local vboxLinks = iup.vbox{gboxLinks, btnSelect; alignment = 'ACENTER', gap = 10, margin = '10x10'}
local fraLinks = iup.frame{vboxLinks; title = 'Links'}
-- define RM elements
local btnExport = iup.button{title = 'Export GEDCOM File',
action = function(self)
ExportGEDCOM()
UpdateMenu()
iup.SetFocus(btnSelect)
end,
TipBalloon = 'YES', TipBalloonTitle = 'Export GEDCOM File',
TipBalloonTitleIcon = '1',
tip = 'Export customized GEDCOM file to create or \nupdate linked RootsMagic database'}
local btnCompare = iup.button{title = 'Compare Project with Linked RM File', padding = '5x3',
TipBalloon = 'YES', TipBalloonTitle = 'Compare RootsMagic Database',
TipBalloonTitleIcon = '1',
tip = 'Generate list of differences between current Project and linked RootsMagic database'}
local btnUpdate = iup.button{title = 'Update Linked RM File',
TipBalloon = 'YES', TipBalloonTitle = 'Update RootsMagic Database',
TipBalloonTitleIcon = '2',
tip = 'Update linked RootsMagic database to reflect current Project contents'}
local vboxRM = iup.vbox{btnCompare, btnExport, btnUpdate;
normalizesize = 'BOTH', gap = 10, margin = '10x10'}
local fraRM = iup.frame{vboxRM; title = 'RootsMagic Synchronization'}
-- define Ancestry elements
local btnDuplicates = iup.button{title = 'Check For Missing or Duplicate Records', padding = '5x3',
action = function(self) AuditAncestryTree() UpdateMenu() end,
TipBalloon = 'YES', TipBalloonTitle = 'Audit Linked Ancestry Tree',
TipBalloonTitleIcon = '3',
tip = 'Compare linked Ancestry tree with RootsMagic database to\n' ..
'check for missing records or accidental duplication'}
local btnGEDCOM = iup.button{title = 'Process Ancestry GEDCOM Export File',
action = function(self) AuditAncestryGEDCOM() UpdateMenu() end,
TipBalloon = 'YES', TipBalloonTitle = 'Remove Ancestry Export Errors',
TipBalloonTitleIcon = '1',
tip = 'Identify duplicate Sex data in Ancestry export GEDCOM, and reformat\n' ..
'file ready for import to Family Historian as new Project'}
local btnAudit = iup.button{title = 'Compare Audit Project with RM File', padding = '5x3',
action = function(self) AuditRMFile(false) UpdateMenu() end, -- active = 'NO',
TipBalloon = 'YES', TipBalloonTitle = 'Audit Linked Ancestry Tree',
TipBalloonTitleIcon = '1',
tip = 'Generate list of differences between current Ancestry-derived \n' ..
'Project and linked RootsMagic database'}
if not gblOptions.TreeID then
btnDuplicates.Active = 'NO'
btnGEDCOM.Active = 'NO'
end
local vboxANC = iup.vbox{btnDuplicates, btnGEDCOM, btnAudit;
normalizesize = 'BOTH', gap = 10; margin = '10x10'}
local fraANC = iup.frame{vboxANC; title = 'Audit Ancestry Tree'}
-- create common buttons
local url = 'https://pluginstore.family-historian.co.uk/page/help/ancestry-synchronization'
local btnOptions = iup.button{title = 'Options',
action = function(self) SelectOptions() UpdateMenu() end,
TipBalloon = 'YES', TipBalloonTitle = 'Options',
TipBalloonTitleIcon = '1',
tip = 'Configure plugin options', padding = '10x3'}
local btnHelp = iup.button{title = 'Help',
action = function(self) fhShellExecute(url) end,
TipBalloon = 'YES', TipBalloonTitle = 'Display Plugin Help',
TipBalloonTitleIcon = '1',
tip = 'Display plugin help page'}
local btnCancel = iup.button{title = 'Close',
action = function(self) return iup.CLOSE end,
TipBalloon = 'YES', TipBalloonTitle = 'Close Plugin',
TipBalloonTitleIcon = '1',
tip = 'Close plugin'}
local buttons = iup.hbox{iup.fill{}, btnOptions, btnHelp, btnCancel, iup.fill{};
normalizesize = 'BOTH', margin = 'x20', gap = 50}
local MainForm
function UpdateMenu()
-- display current RM file if defined
-- (using FSO directly is simpler than converting fhFileUtils epoch time)
if gblOptions.File then
lblRMfile.Title = fhfu.splitPath(gblOptions.File).filename
lblRMfileupdated.Title = FSO:GetFile(gblOptions.File).DateLastModified
lblRMfile.Tip = gblOptions.File
if gblOptions.TreeID then
local TreeURL = gblOptions.URL .. 'tree/' .. gblOptions.TreeID
lnkANC.Title = TreeURL
lnkANC.url = TreeURL
lnkANC.Active = 'YES'
else
lnkANC.Title = ''
lnkANC.Active = 'NO'
end
end
-- is a list of changed records available?
gblOptions.Unchanged = GetUpdateList()
-- modify buttons according to current context
if IsAuditTree() then
fraRM.Active = 'NO'
btnDuplicates.Active = 'NO'
btnGEDCOM.Active = 'NO'
btnAudit.Active = YesNo(gblOptions.File)
else
btnCompare.Active = YesNo(gblOptions.File)
btnUpdate.Active = YesNo(gblOptions.File)
btnAudit.Active = 'NO'
btnDuplicates.Active = YesNo(gblOptions.TreeID)
btnGEDCOM.Active = YesNo(gblOptions.TreeID)
end
if gblOptions.Unchanged and not gblOptions.Full then
btnExport.Title = 'Export GEDCOM Update File'
else
btnExport.Title = 'Export GEDCOM File'
end
MainForm.BringFront = 'YES'
end
function YesNo(b) if b then return 'YES' else return 'NO' end end
function btnCompare:action()
AuditRMFile(false)
UpdateMenu()
end
function btnUpdate:action()
AuditRMFile(true)
UpdateMenu()
end
-- assemble the form
local vboxForm = iup.vbox{fraLinks, iup.hbox{fraRM, iup.fill{}, fraANC;
gap = 10, margin = '10x10'}, buttons; gap = 10, margin = '10x10'}
MainForm = iup.dialog{vboxForm; resize = 'NO', minbox = 'NO', maxbox = 'NO',
title = 'Ancestry Synchronization (' .. gblOptions.Version .. ')'}
MainForm:map() -- ensures layout is preserved for changes in RM file version
UpdateMenu()
if gblOptions.File then
MainForm.StartFocus = btnCompare
else
MainForm.StartFocus = btnExport
end
iup.SetAttribute(MainForm, 'NATIVEPARENT', fhGetContextInfo('CI_PARENT_HWND'))
MainForm:popup()
end
-- *********************************************************************
function DefineFacts()
--[[
Define a common set of Facts for both the initial GEDCOM export and sync with RM.
There is also an option to import a comma-separated list of facts (Tag, Description).
See the help file for more detailed information.
]]
local tblI = {}
local tblF = {}
if gblOptions.BMD then
table.insert(tblI, {Tag = 'BIRT', Description = 'Birth'})
table.insert(tblF, {Tag = 'MARR', Description = 'Marriage'})
table.insert(tblI, {Tag = 'DEAT', Description = 'Death'})
else
-- Individual Facts (custom or standard list)
local FactFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Synchronization Facts.csv'
if fhfu.fileExists(FactFile) then
local Facts = fhLoadTextFile(FactFile)
for Fact in Facts:gmatch('[^\r\n]+') do
local Tag, Description = Fact:match('^([%w%-%_]+)%,([%g%s]+)$')
table.insert(tblI, {Tag = Tag, Description = Description})
end
else
table.insert(tblI, {Tag = 'BIRT', Description = 'Birth'})
table.insert(tblI, {Tag = 'BAPM', Description = 'Baptism'})
table.insert(tblI, {Tag = 'CHR', Description = 'Chr'})
table.insert(tblI, {Tag = 'OCCU', Description = 'Occupation'})
table.insert(tblI, {Tag = 'CENS', Description = 'Census'})
table.insert(tblI, {Tag = 'RESI', Description = 'Residence'})
table.insert(tblI, {Tag = 'EMIG', Description = 'Emigration'})
table.insert(tblI, {Tag = 'IMMI', Description = 'Immigration'})
table.insert(tblI, {Tag = 'NATU', Description = 'Naturalization'})
table.insert(tblI, {Tag = 'RETI', Description = 'Retirement'})
table.insert(tblI, {Tag = 'DEAT', Description = 'Death'})
table.insert(tblI, {Tag = 'BURI', Description = 'Burial'})
table.insert(tblI, {Tag = 'CREM', Description = 'Cremation'})
table.insert(tblI, {Tag = 'PROB', Description = 'Probate'})
table.insert(tblI, {Tag = 'REFN', Description = 'Ref #'})
end
-- Family Facts (do not add additional facts, due to limitation in TreeShare)
table.insert(tblF, {Tag = 'MARR', Description = 'Marriage'})
table.insert(tblF, {Tag = 'DIV', Description = 'Divorce'})
end
return tblI, tblF
end
-- *********************************************************************
function CheckAncestrySyncList()
-- checks for presence of Ancestry Sync list
local GedcomFile = fhGetContextInfo('CI_GEDCOM_FILE')
local Gedcom = fhLoadTextFile(GedcomFile)
return Gedcom:match('1 _LIST Ancestry Sync\r\n')
end
-- *********************************************************************
function IsExcluded(p, family)
-- returns true for out of scope individual or family records
if not family then
local tblP = {}
if fhGetItemText(p, '~._FLGS.__PRIVATE') == 'Y' then table.insert(tblP, 'Private') end
if fhGetItemText(p, '~._FLGS.__LIVING') == 'Y' and not gblOptions.Living then
table.insert(tblP, 'Living') end
if gblOptions.List and not fhCallBuiltInFunction('IsInList', p, 'Ancestry Sync') then
table.insert(tblP, 'List') end
if fhGetItemText(p, '~._UID') == '' then
table.insert(tblP, 'Missing UID')
end
if #tblP > 0 then return table.concat(tblP, ',') end
else
local pH, pW = GetFamilySpouses(p)
-- two visible parents
if pH:IsNotNull() and not IsExcluded(pH) and pW:IsNotNull() and not IsExcluded(pW) then return end
-- no visible parents
if (pH:IsNull() or IsExcluded(pH)) and (pW:IsNull() or IsExcluded(pW)) then return true end
-- one visible parent, so return false if a visible child, true otherwise
local pCHIL = fhGetItemPtr(p, '~.CHIL')
while pCHIL:IsNotNull() do
local pC = fhGetValueAsLink(pCHIL)
if not IsExcluded(pC) then return end
pCHIL:MoveNext('SAME_TAG')
end
return true
end
end
-- *********************************************************************
-- Options functions
-- *********************************************************************
function GetOptions()
local OptionsFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Synchronization.ini'
local tblO = {}
for _, F in ipairs({'Project', 'File', 'GFile', 'AFile'}) do
local File = fhGetIniFileValue(OptionsFile, 'Files', F, 'text')
if File ~= '' then tblO[F] = File end
end
for _, O in ipairs({'Living', 'List', 'BMD', 'Case', 'GEDCOM', 'Full', 'Links', 'Table'}) do
local Option = fhGetIniFileValue(OptionsFile, 'Options', O, 'bool')
if Option then tblO[O] = true end
end
-- check project matches (case-insensitive matching, as it is Windows!)
if tblO.Project then
local StoredProject = fhfu.splitPath(tblO.Project).basename
local StoredPath = fhfu.splitPath(tblO.Project).parent
local Project = fhGetContextInfo('CI_PROJECT_NAME')
local Path = fhfu.splitPath(fhGetContextInfo('CI_PROJECT_FILE')).parent
if StoredProject:lower() ~= Project:lower() then
if StoredPath:lower() ~= Path:lower() then
StoredProject = StoredPath .. '\\' .. StoredProject
Project = Path .. '\\' .. Project
end
local msg = 'Project name differs from stored value. Do you want to reset the RootsMagic ' ..
'file?\n\nProject name: ' .. Project .. '\n\nStored Project: ' .. StoredProject
local Response = MessageBox(msg, 'YESNOCANCEL', 'WARNING')
if Response == 1 then
tblO.File = nil
tblO.GFile = nil
tblO.AFile = nil
elseif Response == 3 then
return
end
end
end
-- is filename valid?
if tblO.File and not (tblO.File):match('%.rmtree$') then
local msg = 'Invalid file name.'
MessageBox(msg, 'OK', 'WARNING')
tblO.File = nil
end
-- does tree file exist on this PC?
if tblO.File and not fhfu.fileExists(tblO.File) then
local msg = 'Specified RootsMagic file is not available on this PC. File name will be reset.'
if MessageBox(msg, 'OKCANCEL', 'WARNING') ~= 1 then return -1 end
tblO.File = nil
tblO.GFile = nil
tblO.AFile = nil
end
-- check RM file if defined
if tblO.File and not CheckRMVersion(tblO.File) then
tblO.File = nil
end
-- get TreeID for the specified tree file
if tblO.File then
local TreeID = GetTreeID(tblO.File)
if TreeID then
tblO.URL = 'https://www.ancestry.com/family-tree/'
tblO.TreeID = TreeID
end
end
-- get timestamp and convert to RM format (days since 31 Dec 1899)
tblO.Now = os.time()/86400 + 25569
tblO.Version = '2.6'
return tblO
end
-- *********************************************************************
function SelectOptions()
-- create options menu
local optLiving = iup.toggle{title = ' Include Individuals marked as Living', expand = 'HORIZONTAL'}
local optList = iup.toggle{title = ' Only Individuals in Ancestry Sync list', expand = 'HORIZONTAL'}
local optBMD = iup.toggle{title = ' Birth, Marriage && Death Facts only', expand = 'HORIZONTAL'}
local vbox1 = iup.vbox{optLiving, optList, optBMD; gap = 10, margin = '10x10'}
local fra1 = iup.frame{vbox1; title = 'Selection options'}
local optCompat = iup.toggle{title = ' Disable RM/Ancestry compatibility for this session',
expand = 'HORIZONTAL'}
local optFull = iup.toggle{title = ' Always export full GEDCOM file', expand = 'HORIZONTAL'}
local vbox2 = iup.vbox{optCompat, optFull; gap = 10, margin = '10x10'}
local fra2 = iup.frame{vbox2; title = 'Export options'}
local optCase = iup.toggle{title = ' Case-sensitive Fact matching', expand = 'HORIZONTAL'}
local vbox3 = iup.vbox{optCase; gap = 10, margin = '10x10'}
local fra3 = iup.frame{vbox3; title = 'Matching options'}
local optGEDCOM = iup.toggle{title = ' Generate GEDCOM export Research Note', expand = 'HORIZONTAL'}
local optLinks = iup.toggle{title = ' Display Family Historian Individuals as Links',
expand = 'HORIZONTAL'}
local optTable = iup.toggle{title = ' Generate cross-reference table on Update', expand = 'HORIZONTAL'}
local vbox4 = iup.vbox{optGEDCOM, optLinks, optTable; gap = 10, margin = '10x10'}
local fra4 = iup.frame{vbox4; title = 'Reporting options'}
local btnOK = iup.button{title = 'OK',
tip = 'Close window and update options'}
local btnCancel = iup.button{title = 'Cancel', padding = '10x3',
action = function(self) return iup.CLOSE end,
tip = 'Close window and leave options unchanged'}
local buttons = iup.hbox{iup.fill{}, btnOK, btnCancel, iup.fill{};
normalizesize = 'BOTH', gap = 50}
local vbox1 = iup.vbox{fra1, fra2; gap = 10, margin = '10x10'}
local vbox2 = iup.vbox{fra3, fra4; gap = 10, margin = '10x10'}
local hbox = iup.hbox{vbox1, vbox2}
local vbox = iup.vbox{hbox, buttons; gap = 10, margin = '10x10'}
local dialog = iup.dialog{vbox; resize = 'No', minbox = 'No', maxbox = 'No',
title = 'Project Synchronization Options'}
function btnOK:action()
gblOptions.Living = optLiving.Value == 'ON'
gblOptions.DisableCompat = optCompat.Value == 'ON'
gblOptions.List = optList.Value == 'ON'
gblOptions.BMD = optBMD.Value == 'ON'
gblOptions.Case = optCase.Value == 'ON'
gblOptions.GEDCOM = optGEDCOM.Value == 'ON'
gblOptions.Full = optFull.Value == 'ON'
gblOptions.Links = optLinks.Value == 'ON'
gblOptions.Table = optTable.Value == 'ON'
return iup.CLOSE
end
-- populate current options
if gblOptions.Living then optLiving.Value = 'ON' end
if not CheckAncestrySyncList() then -- Ancestry Sync list not in project
optList.Value = 'OFF'
optList.Active = 'NO'
gblOptions.List = nil
elseif gblOptions.List then
optList.Value = 'ON'
end
if gblOptions.DisableCompat then optCompat.Value = 'ON' end
if gblOptions.BMD then optBMD.Value = 'ON' end
if gblOptions.Case then optCase.Value = 'ON' end
if gblOptions.GEDCOM then optGEDCOM.Value = 'ON' end
if gblOptions.Full then optFull.Value = 'ON' end
if gblOptions.Links then optLinks.Value = 'ON' end
if gblOptions.Table then optTable.Value = 'ON' end
local FactFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Synchronization Facts.csv'
if fhfu.fileExists(FactFile) then
fra1.Title = 'Selection Options (Custom Fact List)'
end
-- wait for user input
dialog:popup()
end
-- *********************************************************************
function SaveOptions()
-- save current options to disk
local dir = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data'
if not fhfu.folderExists(dir) then fhfu.createFolder(dir) end
local OptionsFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Synchronization.ini'
-- create as Unicode to accept any file path
if not fhSaveTextFile(OptionsFile, '[Files]\n', 'UTF-16LE') then
MessageBox('Cannot create options file', 'OK', 'ERROR')
end
fhSetIniFileValue(OptionsFile, 'Files', 'Project', 'text', fhGetContextInfo('CI_PROJECT_FILE'))
for _, F in ipairs({'File', 'GFile', 'AFile'}) do
if gblOptions[F] then fhSetIniFileValue(OptionsFile, 'Files', F, 'text', gblOptions[F]) end
end
for _, O in ipairs({'Living', 'List', 'BMD', 'Case', 'GEDCOM', 'Full', 'Links', 'Table'}) do
if gblOptions[O] then fhSetIniFileValue(OptionsFile, 'Options', O, 'bool', gblOptions[O]) end
end
end
-- *********************************************************************
-- RM database functions
-- *********************************************************************
function SelectRMFile()
-- warn if GEDCOM not yet exported
if not gblOptions.GFile then
local msg = 'You have not yet exported a GEDCOM file for input into RootsMagic. ' ..
'Are you sure that you want to link a file before doing that?'
if MessageBox(msg, 'OKCANCEL', 'QUESTION', 'Confirm File Link', 2) ~= 1 then return end
end
local filedlg = iup.filedlg{dialogtype = 'OPEN', title = 'Open RootsMagic File',
directory = fhfu.splitPath(gblOptions.File or '').parent,
extfilter = 'RootsMagic Database|*.rmtree|All Files|*.*|'}
filedlg:popup()
if filedlg.Status == '-1' then return end
if not (filedlg.Value):match('%.rmtree$') then return end
-- check database version
if not CheckRMVersion(filedlg.Value) then return end
-- update file admin
gblOptions.File = filedlg.Value
gblOptions.URL = 'https://www.ancestry.com/family-tree/'
gblOptions.TreeID = GetTreeID(filedlg.Value)
end
-- *********************************************************************
function CheckRMVersion(FileName)
local database, SQLFile = OpenDatabase(FileName)
if not database then return end
local SQL = "select substr(DataRec, instr(DataRec,'') + 9, 4) Version, " ..
"substr(DataRec, instr(DataRec,'') + 11, 3) SchemaVersion from ConfigTable"
local ResultSet = database:select(SQL)
local VersionInfo = ResultSet:fetch()
local version = tonumber(VersionInfo.Version)
if not version or version == 6000 then
local msg = 'This plugin does not support RM7 or RM8. Please upgrade to the latest version.'
MessageBox(msg, 'OK', 'ERROR')
return
elseif version == 9000 or version == 1000 then
local msg = 'With effect from May 2026, TreeShare is only supported in RootsMagic 11.1 or later ' ..
'due to the introducion of a new Ancestry API. This plugin will synchronize with RM9 and ' ..
'RM10 databases, but they will not be able to link to Ancestry.\n\n' ..
'TreeShare settings are preserved when upgrading an ' ..
'older database by loading into a supported version of RootsMagic.'
MessageBox(msg, 'OK', 'WARNING')
end
return true
end
-- *********************************************************************
function OpenDatabase(FileName)
-- create copy of RM database file for manipulation (guaranteed ANSI compatibility)
local SQLfile = os.tmpname()
if not fhfu.copyFile(FileName, SQLfile, true) then
local msg = 'Cannot create local copy of RootsMagic file for processing.'
MessageBox(msg, 'OK', 'ERROR')
return
end
local database = fhSQL.connectSQLite(SQLfile)
return database, SQLfile
end
-- *********************************************************************
function GetTreeID(FileName)
-- get Tree ID from RM file
local database, SQLFile = OpenDatabase(FileName)
if not database then return end
SQL = 'SELECT anID FROM AncestryTable LIMIT 1'
ResultSet = database:select(SQL)
local anID = ''
for I in ResultSet:rows() do
anID = I.anID
end
local TreeID = anID:match('^%d+%:%d+%:(%d+)$')
if anID ~= '' and not TreeID then
local msg = 'Cannot determine URL of linked Ancestry tree. ' ..
'RootsMagic database file may be corrupted.'
MessageBox(msg, 'OK', 'WARNING')
end
database:close()
fhfu.deleteFile(SQLfile)
return TreeID
end
-- *********************************************************************
-- Compare and Update functions (evaluation)
-- *********************************************************************
function AuditRMFile(Update)
-- confirm update
if Update then
local msg = 'This option will update your RootsMagic database and cannot be undone using ' ..
'Edit > Undo Plugin Updates as it involves changes to an external file. ' ..
'Are you sure this is what you want to do?\n\nPlease ensure that the database ' ..
'file is not open in RootsMagic.'
if MessageBox(msg, 'YESNO', 'WARNING', nil, 2) ~= 1 then return end
end
local FileName = gblOptions.File
local database, SQLfile = OpenDatabase(FileName)
if not database then return end
-- get RM timestamp before any changes are made
local T = os.date('*t', lfs.attributes(SQLfile, 'modification'))
local TimeStamp = string.format('%04d-%02d-%02d_%02d%02d', T.year, T.month, T.day, T.hour, T.min)
local Tstart = lfs.attributes(SQLfile, 'modification')
-- Read in tables of Facts that are in scope
local tblIndividualFacts, tblFamilyFacts = DefineFacts()
-- Display progress bar
ProgressBarStart(20 + (#tblIndividualFacts + #tblFamilyFacts) * 3)
-- get Individuals
local tblFHI, tblRMI, tblUID = GetIndividuals(database)
-- get Families
local tblFHF = GetFHFamilies()
-- check for duplicate UID
local tblDuplicateUID = CheckDuplicateUID(database)
-- now start comparing facts (including family relationships) for individuals.
local tblUpdates = {}
-- compare living flags
if not IsAuditTree() then
local AlertLiving = CheckLivingFlags(database, tblUID, tblUpdates, Update)
end
-- compare spouses
CheckSpouses(database, tblUID, tblUpdates)
-- compare parents
if CheckParents(database, tblUID, tblFHI, tblFHF, tblUpdates) == -1 then
return
end
-- check names and sex
if Update then
CheckNames(database, tblFHI, tblUpdates, true)
end
CheckNames(database, tblFHI, tblUpdates, false)
if CheckSex(database, tblUID, tblFHI, tblUpdates, Update) and not Update and not IsAuditTree() then
-- alert if difference noted
local msg = "At least one change has been noted in an Individual's recorded Sex.\n\n" ..
'You are strongly recommended to update the RootsMagic file to reflect this change now ' ..
'in order to prevent issues with merging records of different sex.\n\n' ..
'Implement this update?'
if MessageBox(msg, 'YESNO', 'WARNING') == 1 then
MessageBox('Please ensure that the linked file is not open in RootsMagic before clicking on OK.',
'OK', 'WARNING')
CheckSex(database, tblUID, tblFHI, tblUpdates, true)
end
end
-- check Individual Facts (Fact name is RM name, not FH name)
for _, Fact in ipairs(tblIndividualFacts) do
CheckIndividualFact(database, tblUID, tblUpdates, Fact, Update)
end
-- check Family Facts
for _, Fact in ipairs(tblFamilyFacts) do
CheckFamilyFact(database, tblFHI, tblRMI, tblUID, tblFHF, tblUpdates, Fact, Update)
end
-- check for redundant events
CheckRedundantEvents(database, tblRMI, tblUID, tblUpdates, Update)
-- save or process list of changes to update RM timestamps and Ancestry "changed records" list
local UpdateFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync List.txt'
if not Update then -- generate list of changed individuals and save to disk
local tblU = {}
for UID, _ in pairs(tblUpdates) do
table.insert(tblU, tblUID[UID].IDrm)
end
if #tblU > 0 then
fhSaveTextFile(UpdateFile, table.concat(tblU, '\n'))
end
else -- update RM timestamps
UpdateRMTimeStamps(database, SQLfile)
UpdateAncestryList(database, SQLfile, tblUID)
fhfu.deleteFile(UpdateFile)
end
-- finished with RM, so connection can be closed
database:close()
-- create Research Note to output results
ProgressBarIncrement('Preparing Report')
local rt = fhNewRichText()
if IsAuditTree() then
rt:AddText('Title:\tRootsMagic - Ancestry Audit Guide\n')
elseif Update then
rt:AddText('Title:\tRootsMagic Update Guide\n')
else
rt:AddText('Title:\tRootsMagic - Ancestry TreeShare Update Guide\n')
end
rt:AddText('Type:\tAncestry Sync\n')
rt:AddText('Date:\t' .. os.date('%d' .. ' ' .. '%b' .. ' ' .. '%Y') .. '\n')
rt:AddText('Status:\topen\n')
rt:AddText('Ver:\t' .. gblOptions.Version .. '\n\n')
rt:AddText('')
rt:AddText('FH Project: | ' .. fhGetContextInfo('CI_PROJECT_NAME') .. ' (' ..
fhGetContextInfo('CI_PROJECT_FILE'):gsub('\\', '\\\\') .. '
')
rt:AddText('RM File: | ' .. FileName:gsub('\\', '\\\\') .. '
')
if gblOptions.TreeID then
rt:AddText('Ancestry Tree: |
')
end
rt:AddText('\n\n')
if IsAuditTree() then
rt:AddText('This Research Note lists all differences between the nominated RootsMagic file and ' ..
'the current Project. If you have completed the RootsMagic and Ancestry updates, it ' ..
'represents the events that should be reviewed within TreeShare to ensure that the ' ..
'Ancestry tree is a true match to your project. See the ' ..
' ' ..
'for more details of the auditing process.\n\n')
elseif Update then
rt:AddText('This Research Note lists all remaining differences between the nominated RootsMagic ' ..
'file and the current Project that cannot be processed automatically by the plugin. ' ..
'Make these changes in RootsMagic prior to running TreeShare to upload all changes to ' ..
'Ancestry.\n\n')
else
rt:AddText('This Research Note lists all differences between the nominated RootsMagic file and ' ..
'the current Project. If the RM-Ancestry sync is currently up to date, this is the list ' ..
'of changes that will need to be uploaded to Ancestry using RootsMagic TreeShare once ' ..
'the RootsMagic database has been updated.\n\n')
end
-- record counts
local FHI = 0
for _,_ in pairs(tblFHI) do FHI = FHI + 1 end
local RMI = 0
for _,_ in pairs(tblRMI) do RMI = RMI + 1 end
rt:AddText('FH Individuals: \t' .. FHI .. '\n')
rt:AddText('RM Individuals: \t' .. RMI .. '\n')
-- which Individuals are missing from RM/Ancestry?
local tblAdd, tblDelete = CheckIndividuals(tblUID)
if #tblAdd > 0 then
rt:AddText('\nNew Individuals to be added to RootsMagic:\n\n')
for _, pI in ipairs(tblAdd) do
AddFHRecord(pI, rt)
rt:AddText(' (FH' .. fhGetRecordId(pI) .. ')\n')
end
end
-- which Individuals are missing from FH?
if #tblDelete > 0 then
if not IsAuditTree() then
rt:AddText('\nIndividuals to be deleted from RootsMagic:\n\n')
else
rt:AddText('\nIndividuals with missing UniqueID in Ancestry export (may also impact reported differences):\n\n')
end
for _, I in ipairs(tblDelete) do
if I.Given == '' or I.Surname == '' then
rt:AddText(I.Given .. (I.Surname):upper() .. ' (RM' .. I.IDrm .. ')\n')
else
rt:AddText(I.Given .. ' ' .. (I.Surname):upper() .. ' (RM' .. I.IDrm .. ')\n')
end
end
end
-- count and report changed individuals
local ChangedIndividuals = 0
for _, _ in pairs(tblUpdates) do ChangedIndividuals = ChangedIndividuals + 1 end
if ChangedIndividuals > 0 then
local tblUpdates = SortChangedIndividuals(tblUID, tblUpdates)
rt:AddText('\nDifferences in Individual Records:\n\n')
for _, I in ipairs(tblUpdates) do
local UID = I.UID
AddFHRecord(tblUID[UID].p, rt)
rt:AddText(' (FH' .. tblUID[UID].IDfh .. '/RM' .. tblUID[UID].IDrm .. ') - ')
local PreviousItem = ''
local tblT = {}
for _, Item in ipairs(I.Facts) do
if Item ~= PreviousItem then table.insert(tblT, Item) end
PreviousItem = Item
end
rt:AddText(table.concat(tblT, ', ') .. '\n')
end
end
-- report duplicate individuals
if #tblDuplicateUID > 0 then
rt:AddText('\nDuplicate Individuals in RootsMagic:\n\n')
rt:AddText('These are duplicate individuals in the RootsMagic database that arise from a ' ..
'failed merge process. This is most commonly caused by a change in recorded sex, ' ..
'as records can only be merged if they are of the same sex. Please amend the ' ..
'incorrect sex in RootsMagic and manually merge the two records prior to ' ..
'rerunning the plugin.\n\n')
for _, I in ipairs(tblDuplicateUID) do
AddFHRecord(tblUID[I].p, rt)
rt:AddText(' (FH' .. tblUID[I].IDfh .. '/RM' .. tblUID[I].IDrm .. ')')
end
rt:AddText('\n')
end
-- alert to changes in Living status
if AlertLiving then
rt:AddText('\nNOTE:\n\nRootsMagic TreeShare may not detect a change in Living status ' ..
'when syncing with Ancestry. Please ensure that you check the relevant Ancestry ' ..
'record carefully to ensure that living individual privacy is protected.\n')
end
-- alert to RM deletions
if #tblDelete > 0 and Update then
rt:AddText('\nNOTE:\n\nWhere individuals are to be deleted, you may find it easier to ' ..
'delete the relevant individuals first, then re-run the Update process. Deleting an ' ..
'individual in either RootsMagic or Ancestry also deletes all their facts and ' ..
'relationships, so some of the differences reported here may no longer be relevant.\n')
end
-- do databases match?
local match = (FHI == RMI and #tblAdd + #tblDelete + ChangedIndividuals == 0)
-- generate list of changed records for smaller GEDCOM file and quicker RM merge
if match then
rt:AddText('\nNo differences identified.')
elseif not Update then
SetUpdateList(tblUpdates, tblAdd, tblUID)
end
-- create Research Note from assembled content
local pRN = fhCreateItem('_RNOT')
local pT = fhGetItemPtr(pRN, '~.TEXT')
fhSetValueAsRichText(pT, rt)
-- backup RM database before updating (if updated)
if lfs.attributes(SQLfile, 'modification') > Tstart then
local Path = fhfu.splitPath(FileName)
local BackupFile = Path.parent .. '\\~' .. Path.filename .. '.' .. TimeStamp .. '.bak'
if not fhfu.copyFile(FileName, BackupFile, true) then
local msg = 'RootsMagic backup failed. File not updated.'
MessageBox(msg, 'OK', 'ERROR')
return
end
if not fhfu.copyFile(SQLfile, FileName, true) then
local msg = 'RootsMagic update failed.'
MessageBox(msg, 'OK', 'ERROR')
return
end
end
fhfu.deleteFile(SQLfile)
-- save audit result and close progress bar now all complete
gblProgBar.Dialog:destroy()
gblProgBar = nil
fhUpdateDisplay()
-- generate record list
if Update and gblOptions.Table then CreateRecordList(tblUID) end
-- clear large tables
tblFHI = nil
tblRMI = nil
tblUID = nil
tblFHF = nil
collectgarbage('collect')
-- display confirmation
local endmsg
if Update then
endmsg = 'RootsMagic file update completed and reported as new Research Note.'
else
endmsg = 'RootsMagic comparison completed and reported as new Research Note.'
end
if match then
if Update then
endmsg = endmsg .. '\n\nNo remaining differences identified.'
else
endmsg = endmsg .. '\n\nNo differences identified.'
end
end
MessageBox(endmsg, 'OK', 'INFORMATION')
end
-- *********************************************************************
function GetIndividuals(database)
local tblFHI = {}
local tblRMI = {}
local tblUID = {}
local pI = fhNewItemPtr()
local count = 0
-- get FH records
ProgressBarIncrement('Getting FH Individuals')
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
if not IsExcluded(pI) then
local ID = fhGetRecordId(pI)
local UID = GetUID(pI)
tblFHI[ID] = {}
tblFHI[ID].p = pI:Clone()
tblFHI[ID].UID = UID
tblUID[UID] = {}
tblUID[UID].IDfh = ID
tblUID[UID].p = pI:Clone()
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
pI:MoveNext()
end
-- get RM records
ProgressBarIncrement('Getting RM Individuals')
count = 0
SQL = 'SELECT UniqueID, PersonID, Surname, Given ' ..
'FROM PersonTable, NameTable WHERE PersonID = OwnerID and IsPrimary = 1'
ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local ID = tonumber(p.PersonID)|0
local UID = p.UniqueID
tblRMI[ID] = {}
tblRMI[ID].Given = p.Given
tblRMI[ID].Surname = p.Surname:upper()
tblRMI[ID].UID = UID
if not tblUID[UID] then tblUID[UID] = {} end
tblUID[UID].IDrm = ID
tblUID[UID].Given = p.Given
tblUID[UID].Surname = p.Surname
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
collectgarbage('collect')
return tblFHI, tblRMI, tblUID
end
-- *********************************************************************
function CheckDuplicateUID(database)
local tblT = {}
local SQL = 'SELECT UniqueID FROM PersonTable GROUP BY UniqueID HAVING COUNT(*) > 1'
local ResultSet = database:select(SQL)
for P in ResultSet:rows() do
table.insert(tblT, P.UniqueID)
end
return tblT
end
-- *********************************************************************
function GetFHFamilies()
local p = fhNewItemPtr()
local pF = fhNewItemPtr()
local tblFHF = {}
local count = 0
ProgressBarIncrement('Getting FH Families')
pF:MoveToFirstRecord('FAM')
while pF:IsNotNull() do
if not IsExcluded(pF, true) then
local pH, pW = GetFamilySpouses(pF)
local ID = fhGetRecordId(pF)
tblFHF[ID] = {}
tblFHF[ID].p = pF:Clone()
if pH:IsNotNull() and not IsExcluded(pH) then tblFHF[ID].IDh = fhGetRecordId(pH) end
if pW:IsNotNull() and not IsExcluded(pW) then tblFHF[ID].IDw = fhGetRecordId(pW) end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
pF:MoveNext()
end
return tblFHF
end
-- *********************************************************************
function CheckLivingFlags(database, tblUID, tblUpdates, Update)
local tblFH = {}
local tblRM = {}
local alert
local count = 0
-- get FH Living flags
ProgressBarIncrement('Getting FH Living flags')
for UID, I in pairs(tblUID) do
if I.IDfh and fhGetItemText(I.p, '~._FLGS.__LIVING') == 'Y' then
tblFH[UID] = true
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM Living flags
ProgressBarIncrement('Getting RM Living flags')
count = 0
local SQL = 'SELECT UniqueID FROM PersonTable WHERE Living = 1'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
tblRM[p.UniqueID] = true
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- update RM flags to match FH
ProgressBarIncrement('Comparing Living flags')
count = 0
local tblSQL = {}
local tblSetLiving = {}
local tblClearLiving = {}
for UID, I in pairs(tblUID) do
if I.IDrm then
local change
if tblUID[UID].IDfh and tblFH[UID] and not tblRM[UID] then
table.insert(tblSetLiving, I.IDrm)
change = true
elseif tblUID[UID].IDfh and not tblFH[UID] and tblRM[UID] then
table.insert(tblClearLiving, I.IDrm)
change = true
end
if change and not Update then -- record the difference
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], 'Living Flag')
alert = true
end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
if Update then -- remove the differences
while #tblSetLiving > 0 do
table.insert(tblSQL, table.remove(tblSetLiving)) -- transfer one value to SQL table
if #tblSetLiving == 0 or #tblSQL > 999 then -- update this block of values
local SQL = 'UPDATE PersonTable SET Living = 1, UTCModDate = ' .. gblOptions.Now ..
' WHERE PersonID IN (' .. table.concat(tblSQL, ',') .. ')'
database:execute(SQL)
tblSQL = {}
end
end
while #tblClearLiving > 0 do
table.insert(tblSQL, table.remove(tblClearLiving)) -- transfer one value to SQL table
if #tblClearLiving == 0 or #tblSQL > 999 then -- update this block of values
local SQL = 'UPDATE PersonTable SET Living = 0, UTCModDate = ' .. gblOptions.Now ..
' WHERE PersonID IN (' .. table.concat(tblSQL, ',') .. ')'
database:execute(SQL)
tblSQL = {}
end
end
end
tblFH = nil
tblRM = nil
ResultSet = nil
collectgarbage('collect')
return alert
end
-- *********************************************************************
function CheckSpouses(database, tblUID, tblUpdates)
local tblT = {}
local count = 0
-- get FH spouses
ProgressBarIncrement('Getting FH Spouses')
local pF = fhNewItemPtr()
pF:MoveToFirstRecord('FAM')
while pF:IsNotNull() do
local pH, pW = GetFamilySpouses(pF)
if pH:IsNotNull() and pW:IsNotNull() then -- both spouses known
if not IsExcluded(pH) and not IsExcluded(pW) then
local UIDh = FormatUID(fhGetItemText(pH, '~._UID'))
local UIDw = FormatUID(fhGetItemText(pW, '~._UID'))
if not tblT[UIDh] then
tblT[UIDh] = {}
tblT[UIDh].FH = {}
end
table.insert(tblT[UIDh].FH, UIDw)
if not tblT[UIDw] then
tblT[UIDw] = {}
tblT[UIDw].FH = {}
end
table.insert(tblT[UIDw].FH, UIDh)
end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
pF:MoveNext()
end
-- get RM spouses
ProgressBarIncrement('Getting RM Spouses')
count = 0
local SQL = 'SELECT P1.UniqueID UIDh, P2.UniqueID UIDw FROM FamilyTable F ' ..
'LEFT JOIN PersonTable P1 ON F.FatherID = P1.PersonID ' ..
'LEFT JOIN PersonTable P2 ON F.MotherID = P2.PersonID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local UIDh = p.UIDh
local UIDw = p.UIDw
if UIDh and UIDw then
if not tblT[UIDh] then tblT[UIDh] = {} end
if not tblT[UIDh].RM then tblT[UIDh].RM = {} end
table.insert(tblT[UIDh].RM, UIDw)
if not tblT[UIDw] then tblT[UIDw] = {} end
if not tblT[UIDw].RM then tblT[UIDw].RM = {} end
table.insert(tblT[UIDw].RM, UIDh)
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- sort spouses for comparison
ProgressBarIncrement('Comparing Spouses')
count = 0
for UID, Spouses in pairs(tblT) do
if Spouses.FH then
table.sort(Spouses.FH)
Spouses.FH = table.concat(Spouses.FH)
end
if Spouses.RM then
table.sort(Spouses.RM)
Spouses.RM = table.concat(Spouses.RM)
end
end
-- compare spouses
for UID, Spouses in pairs(tblT) do
if not Spouses.FH or not Spouses.RM or Spouses.FH ~= Spouses.RM then
if tblUID[UID].IDfh and tblUID[UID].IDrm then -- do not include missing individuals
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], 'Spouse')
end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
tblT = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckParents(database, tblUID, tblFHI, tblFHF, tblUpdates)
local p = fhNewItemPtr()
local tblT = {}
local count = 0
local null_count = 0
local function GetParentString(tblP)
local tblT = {}
if tblP.F then
table.insert(tblT, (tblP.F.UID or ''))
table.insert(tblT, (tblP.F.Relationship or ''))
end
if tblP.M then
table.insert(tblT, (tblP.M.UID or ''))
table.insert(tblT, (tblP.M.Relationship or ''))
end
return table.concat(tblT)
end
-- get FH parents
ProgressBarIncrement('Getting FH Parents')
for _, I in pairs(tblFHI) do
local UID = FormatUID(fhGetItemText(I.p, '~._UID'))
p:MoveTo(I.p, '~.FAMC')
while p:IsNotNull() do
local pF = fhGetValueAsLink(p)
local ID = fhGetRecordId(pF)
local pH, pW = GetFamilySpouses(pF)
local Frel, Mrel = GetParentRelationships(I.p, pF)
if tblFHF[ID] then -- exclude unlisted families
if not tblT[UID] then tblT[UID] = {FH = {}, RM = {}} end
local tblP = {} -- table for this family relationships
if pH:IsNotNull() and not IsExcluded(pH) then -- father listed
tblP.F = {}
tblP.F.UID = FormatUID(fhGetItemText(pH, '~._UID'))
tblP.F.Relationship = Frel
end
if pW:IsNotNull() and not IsExcluded(pW) then -- mother listed
tblP.M = {}
tblP.M.UID = FormatUID(fhGetItemText(pW, '~._UID'))
tblP.M.Relationship = Mrel
end
table.insert(tblT[UID].FH, tblP)
end
p:MoveNext('SAME_TAG')
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM parents
local tblR = {'birth', 'adopted', 'step', 'foster'}
ProgressBarIncrement('Getting RM Parents')
count = 0
local SQL = 'SELECT Pc.UniqueID UID, Pf.UniqueID UIDf, Pm.UniqueID UIDm, ' ..
'C.RelFather RelF, C.RelMother RelM FROM ChildTable C ' ..
'INNER JOIN FamilyTable F ON C.FamilyID = F.FamilyID ' ..
'LEFT JOIN PersonTable Pc ON C.ChildID = Pc.PersonID ' ..
'LEFT JOIN PersonTable Pf ON F.FatherID = Pf.PersonID ' ..
'LEFT JOIN PersonTable Pm ON F.MotherID = Pm.PersonID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local UID = p.UID
local UIDf = p.UIDf
local RelF = p.RelF
local UIDm = p.UIDm
local RelM = p.RelM
if UID then
if not tblT[UID] then tblT[UID] = {FH = {}, RM = {}} end
local tblP = {}
if UIDf then
tblP.F = {}
tblP.F.UID = UIDf
if RelF < 4 then tblP.F.Relationship = tblR[RelF+1] end
end
if UIDm then
tblP.M = {}
tblP.M.UID = UIDm
if RelM < 4 then tblP.M.Relationship = tblR[RelM+1] end
end
table.insert(tblT[UID].RM, tblP)
else
null_count = null_count + 1
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
if null_count > 0 then
local msg = 'Cannot get RootsMagic Parent identities. ' ..
'RM database file may be corrupted.'
MessageBox(msg, 'OK', 'ERROR')
ResultSet = nil
tblT = nil
collectgarbage('collect')
return -1
end
-- compare parents
ProgressBarIncrement('Comparing Parents')
count = 0
for UID, tblA in pairs(tblT) do
if tblUID[UID].IDfh and tblUID[UID].IDrm then -- ignore missing individuals
local match = false
for _, tblFHP in ipairs(tblA.FH) do
local FHstring = GetParentString(tblFHP)
for _, tblRMP in ipairs(tblA.RM) do
local RMstring = GetParentString(tblRMP)
if FHstring == RMstring then -- matching parents found
match = true
break
end
end
end
for _, tblRMP in ipairs(tblA.RM) do
local RMstring = GetParentString(tblRMP)
for _, tblFHP in ipairs(tblA.FH) do
local FHstring = GetParentString(tblFHP)
if FHstring == RMstring then -- matching parents found
match = true
break
end
end
end
if not match then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], 'Parents')
end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
tblT = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckNames(database, tblFHI, tblUpdates, Update)
local tblFH = {}
local tblRM = {}
local count = 0
-- get FH Individual names (turn off preference setting temporarily to ensure case-sensitive)
ProgressBarIncrement('Getting FH Names')
fhOverridePreference('SURNAMES_UPPERCASE', true, false)
for _, I in pairs(tblFHI) do
local pN = fhNewItemPtr()
local tblNames = {}
pN:MoveTo(I.p, '~.NAME')
if pN:IsNull() then -- use dummy name to match RM name
local tblN = {Given = '?', Surname = '', Prefix = '', Suffix = '', Nickname = ''}
table.insert(tblNames, tblN)
end
while pN:IsNotNull() do
local tblN = {}
tblN.Given = fhGetItemText(pN, '~.GIVN')
tblN.GivenAll = fhGetItemText(pN, '~:GIVEN_ALL')
tblN.Surname = fhGetItemText(pN, '~:SURNAME')
tblN.Prefix = fhGetItemText(pN, '~.NPFX')
tblN.Suffix = fhGetItemText(pN, '~.NSFX')
tblN.Nickname = fhGetItemText(pN, '~.NICK')
table.insert(tblNames, tblN)
pN:MoveNext('SAME_TAG') -- alternative names
end
tblFH[I.UID] = tblNames
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
fhOverridePreference('SURNAMES_UPPERCASE', false)
-- get all RM Individual names
ProgressBarIncrement('Getting RM Names')
count = 0
local SQL = 'SELECT UniqueID, NameID, Surname, Given, Prefix, Suffix, Nickname, IsPrimary ' ..
'FROM PersonTable, NameTable WHERE PersonID = OwnerID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local tblN = {}
local UID = p.UniqueID
tblN.NameID = tonumber(p.NameID)|0
tblN.Prefix = p.Prefix
tblN.Suffix = p.Suffix
tblN.Nickname = p.Nickname
tblN.Given = p.Given
tblN.Surname = p.Surname
if not tblRM[UID] then tblRM[UID] = {} end
if p.IsPrimary == 1 then
table.insert(tblRM[UID], 1, tblN) -- top of table
else
table.insert(tblRM[UID], tblN) -- end of table
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ProgressBarIncrement('Comparing Names')
-- clear Prefix and Nickname if auditing
if IsAuditTree() then
for UID, Names in pairs(tblFH) do
for _, Name in ipairs(Names) do
Name.Prefix = nil
Name.Nickname = nil
end
end
for UID, Names in pairs(tblRM) do
for _, Name in ipairs(Names) do
Name.Prefix = nil
Name.Nickname = nil
end
end
end
-- compare names
count = 0
for UID, Names in pairs(tblFH) do
if tblRM[UID] then
local matchPrimary, matchAlternative
if #Names == 1 and #tblRM[UID] == 1 then
matchAlternative = true -- no alternative names
end
for iFH = 1, #Names do
for iRM = 1, #tblRM[UID] do
if Names[iFH].Prefix == tblRM[UID][iRM].Prefix and
Names[iFH].Suffix == tblRM[UID][iRM].Suffix and
(Names[iFH].Given == tblRM[UID][iRM].Given or
Names[iFH].GivenAll == tblRM[UID][iRM].Given) and
Names[iFH].Surname == tblRM[UID][iRM].Surname and
Names[iFH].Nickname == tblRM[UID][iRM].Nickname then
if iFH == 1 and iRM == 1 then
matchPrimary = true
elseif iFH > 1 and iRM > 1 then
matchAlternative = true
end
if Update and iFH == 1 and iRM > 1 then -- update primary name in RM
for _, N in ipairs(tblRM[UID]) do
SQL = 'UPDATE NameTable SET IsPrimary = 0, UTCModDate = ' ..
gblOptions.Now .. ' WHERE NameID = ' .. N.NameID
database:execute(SQL)
end
SQL = 'UPDATE NameTable SET IsPrimary = 1, UTCModDate = ' ..
gblOptions.Now .. ' WHERE NameID = ' .. tblRM[UID][iRM].NameID
database:execute(SQL)
end
end
end
end
if (not matchPrimary or not matchAlternative) and not Update then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
if not matchPrimary then table.insert(tblUpdates[UID], 'Primary Name') end
if not matchAlternative then table.insert(tblUpdates[UID], 'Alternative Name') end
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
tblFH = nil
tblRM = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckSex(database, tblUID, tblFHI, tblUpdates, Update)
local tblFH = {}
local tblRM = {}
local alert
local count = 0
-- get FH Individual details
ProgressBarIncrement('Getting FH Sex')
for _, I in pairs(tblFHI) do
local Sex = fhGetItemText(I.p, '~.SEX')
if Sex == '' then Sex = 'Unknown' end
tblFH[I.UID] = Sex
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM Individual details
ProgressBarIncrement('Getting RM Sex')
count = 0
local tblSex = {'Male', 'Female', 'Unknown'}
local SQL = 'SELECT UniqueID, Sex FROM PersonTable'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
tblRM[p.UniqueID] = tblSex[p.Sex + 1]
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- compare tables
ProgressBarIncrement('Comparing Sex')
count = 0
for _, I in pairs(tblFHI) do
local UID = I.UID
if tblFH[UID] and tblRM[UID] and tblFH[UID] ~= tblRM[UID] then
if Update then
local NewSex = 0
if tblFH[UID] == 'Female' then NewSex = 1
elseif tblFH[UID] == 'Unknown' then NewSex = 2 end
SQL = 'UPDATE PersonTable SET Sex = ' .. NewSex .. ', UTCModDate = ' .. gblOptions.Now ..
' WHERE PersonID = ' .. tblUID[UID].IDrm
database:execute(SQL)
if gblOptions.TreeID then
SQL = 'UPDATE AncestryTable SET Modified = 1, UTCModDate = ' .. gblOptions.Now ..
' WHERE rmID = ' .. tblUID[UID].IDrm
database:execute(SQL)
end
else
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], 'Sex')
alert = true
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
tblFH = nil
tblRM = nil
collectgarbage('collect')
return alert
end
-- *********************************************************************
function CheckIndividualFact(database, tblUID, tblUpdates, Fact, Update)
local tblFH = {}
local tblRM = {}
local count = 0
-- do not compare if Census, as these included in Residence, and no values in RM
if Fact.Tag == 'CENS' then return end
-- get FH Individual details
ProgressBarIncrement('Getting FH ' .. Fact.Description)
for UID, I in pairs(tblUID) do
if I.IDfh then
local p = fhNewItemPtr()
if Fact.Tag == 'RESI' then -- also include Census entries
p:MoveTo(I.p, '~.CENS')
while p:IsNotNull() do
local Value = fhGetValueAsText(p) -- attributes only
local Date = fhGetItemText(p, '~.DATE')
local Place = fhGetItemText(p, '~.PLAC')
local Event = Value .. Date .. Place:gsub(' ', '')
if Event ~= '' and fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if not tblFH[UID] then tblFH[UID] = {} end
tblFH[UID][Event] = true
end
p:MoveNext('SAME_TAG')
end
end
p:MoveTo(I.p, '~.' .. Fact.Tag)
while p:IsNotNull() do
local Value = fhGetValueAsText(p) -- attributes only
local Date = fhGetItemText(p, '~.DATE')
local Place = fhGetItemText(p, '~.PLAC')
local Event = Value .. Date .. Place:gsub(' ', '')
if Event ~= '' and fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if not tblFH[UID] then tblFH[UID] = {} end
tblFH[UID][Event] = true
end
p:MoveNext('SAME_TAG')
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM Individual details
ProgressBarIncrement('Getting RM ' .. Fact.Description)
count = 0
local SQL = 'SELECT I.UniqueID UniqueID, E.EventID EventID, E.Date Date, P.Name Place, ' ..
'E.Details Details FROM EventTable E ' ..
'JOIN FactTypeTable F ON E.EventType = F.FactTypeID AND ' ..
'F.Abbrev = "' .. Fact.Description .. '" ' ..
'JOIN PersonTable I ON E.OwnerID = I.PersonID ' ..
'LEFT JOIN PlaceTable P ON E.PlaceID = P.PlaceID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local UID = p.UniqueID
local Details = p.Details
local Date = FormatRMDate(p.Date)
local Place = p.Place
local Event = (Details or '') .. (Date or '') .. (Place or ''):gsub(' ', '')
if not tblRM[UID] then tblRM[UID] = {} end
if Event ~= '' then tblRM[UID][Event] = tonumber(p.EventID)|0 end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count, 'Facts') end
end
-- find FH facts that are not in RM and add to list for prompted sync
ProgressBarIncrement('Comparing ' .. Fact.Description)
for UID, Events in pairs(tblFH) do
for Event, _ in pairs(Events) do
if tblUID[UID].IDfh and tblUID[UID].IDrm and not MatchEvent(UID, Event, tblRM) then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], Fact.Description)
end
end
end
-- find RM facts that are not in FH, and delete
local tblX = {} -- Events to be deleted
for UID, Events in pairs(tblRM) do
for Event, EventID in pairs(Events) do
if tblUID[UID].IDfh and tblUID[UID].IDrm and not MatchEvent(UID, Event, tblFH) then
if Update then
table.insert(tblX, EventID)
else
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], Fact.Description)
end
end
end
end
if #tblX > 0 and Update then
for _, Event in ipairs(tblX) do
SQL = 'DELETE FROM EventTable WHERE EventID = ' .. Event
database:execute(SQL)
end
end
ResultSet = nil
tblFH = nil
tblRM = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckFamilyFact(database, tblFHI, tblRMI, tblUID, tblFHF, tblUpdates, Fact, Update)
local tblFH = {}
local tblRM = {}
local count = 0
-- get FH Family details
ProgressBarIncrement('Getting FH ' .. Fact.Description)
for _, F in pairs(tblFHF) do
local UIDh, UIDw
if F.IDh then UIDh = tblFHI[F.IDh].UID end
if F.IDw then UIDw = tblFHI[F.IDw].UID end
local pF = F.p
local p = fhNewItemPtr()
p:MoveTo(pF, '~.' .. Fact.Tag)
while p:IsNotNull() do
local Value = fhGetValueAsText(p) -- attributes only
local Date = fhGetItemText(p, '~.DATE')
local Place = fhGetItemText(p, '~.PLAC')
local Event = Value .. Date .. Place:gsub(' ', '')
if Event ~= '' and UIDh and fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if not tblFH[UIDh] then tblFH[UIDh] = {} end
tblFH[UIDh][Event] = true
end
if Event ~= '' and UIDw and fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if not tblFH[UIDw] then tblFH[UIDw] = {} end
tblFH[UIDw][Event] = true
end
p:MoveNext('SAME_TAG')
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM Family details
ProgressBarIncrement('Getting RM ' .. Fact.Description)
count = 0
local SQL = 'SELECT Fam.FatherID FatherID, Fam.MotherID MotherID, E.EventID EventID, E.Date Date, ' ..
'P.Name Place, E.Details Details FROM EventTable E ' ..
'JOIN FactTypeTable F ON E.EventType = F.FactTypeID ' ..
'JOIN FamilyTable Fam ON E.OwnerID = Fam.FamilyID and F.Abbrev = "' ..
Fact.Description .. '" ' ..
'LEFT JOIN PlaceTable P ON E.PlaceID = P.PlaceID'
local ResultSet = database:select(SQL)
for f in ResultSet:rows() do
local UIDf, UIDm
local FatherID = tonumber(f.FatherID)|0
local MotherID = tonumber(f.MotherID)|0
local EventID = tonumber(f.EventID)|0
if FatherID > 0 and tblRMI[FatherID] then UIDf = tblRMI[FatherID].UID end
if MotherID > 0 and tblRMI[MotherID] then UIDm = tblRMI[MotherID].UID end
local Details = f.Details
local Date = FormatRMDate(f.Date)
local Place = f.Place
local Event = (Details or '') .. (Date or '') .. (Place or ''):gsub(' ', '')
if Event ~= '' and UIDf then -- assign fact to father
if not tblRM[UIDf] then tblRM[UIDf] = {} end
tblRM[UIDf][Event] = EventID
end
if Event ~= '' and UIDm then -- assign fact to mother
if not tblRM[UIDm] then tblRM[UIDm] = {} end
tblRM[UIDm][Event] = EventID
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- find FH facts that are not in RM and add to list for prompted sync
ProgressBarIncrement('Comparing ' .. Fact.Description)
for UID, Events in pairs(tblFH) do
for Event, _ in pairs(Events) do
if tblUID[UID].IDfh and tblUID[UID].IDrm and not MatchEvent(UID, Event, tblRM) then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], Fact.Description)
end
end
end
-- find RM facts that are not in FH, and delete
local tblX = {} -- Events to be deleted
for UID, Events in pairs(tblRM) do
for Event, EventID in pairs(Events) do
if tblUID[UID].IDfh and tblUID[UID].IDrm and not MatchEvent(UID, Event, tblFH) then
if Update then
table.insert(tblX, EventID)
else
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], Fact.Description)
end
end
end
end
if #tblX > 0 and Update then
for _, Event in ipairs(tblX) do
SQL = 'DELETE FROM EventTable WHERE EventID = ' .. Event
database:execute(SQL)
end
end
ResultSet = nil
tblFH = nil
tblRM = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckRedundantEvents(database, tblRMI, tblUID, tblUpdates, Update)
-- check for events in RM not included in standard set
ProgressBarIncrement('Checking Redundant Events')
local tblI, tblF = DefineFacts()
local tblT = {} -- Event types to be deleted
local tblX = {} -- Specific events to be deleted
local count = 0
-- get Individual Events
for _,Fact in ipairs(tblI) do table.insert(tblT, '"' .. Fact.Description .. '"') end
local EventList = table.concat(tblT, ',')
local SQL = 'SELECT I.UniqueID UniqueID, E.EventID EventID, F.Abbrev FROM EventTable E ' ..
'JOIN FactTypeTable F ON E.EventType = F.FactTypeID AND ' ..
'F.Abbrev NOT IN (' .. EventList .. ') AND E.OwnerType = 0 ' ..
'JOIN PersonTable I ON E.OwnerID = I.PersonID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local UID = p.UniqueID
local EventID = tonumber(p.EventID)|0
if Update then
table.insert(tblX, EventID)
else
if tblUID[UID].IDfh then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], p.Abbrev)
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count, 'Facts') end
end
-- get Family Events
tblT = {}
for _, Fact in ipairs(tblF) do table.insert(tblT, '"' .. Fact.Description .. '"') end
EventList = table.concat(tblT, ',')
SQL = 'SELECT Fam.FamilyID FamilyID, Fam.FatherID FatherID, Fam.MotherID MotherID, ' ..
'E.EventID EventID, F.Abbrev FROM EventTable E ' ..
'JOIN FactTypeTable F ON E.EventType = F.FactTypeID AND F.Abbrev NOT IN (' ..
EventList .. ') AND E.OwnerType = 1 ' ..
'JOIN FamilyTable Fam ON E.OwnerID = Fam.FamilyID'
local ResultSet = database:select(SQL)
for f in ResultSet:rows() do
local EventID = tonumber(f.EventID)|0
local FatherID = tonumber(f.FatherID)|0
local MotherID = tonumber(f.MotherID)|0
if Update then
table.insert(tblX, EventID)
else
if FatherID > 0 then -- father event list
local UIDf = tblRMI[FatherID].UID
if tblUID[UIDf].IDfh then
if not tblUpdates[UIDf] then tblUpdates[UIDf] = {} end
table.insert(tblUpdates[UIDf], f.Abbrev)
end
end
if MotherID > 0 then -- mother event list
local UIDm = tblRMI[MotherID].UID
if tblUID[UIDm].IDfh then
if not tblUpdates[UIDm] then tblUpdates[UIDm] = {} end
table.insert(tblUpdates[UIDm], f.Abbrev)
end
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count, 'Facts') end
end
-- delete redundant events if updating
local tblSQL = {}
while #tblX > 0 and Update do
table.insert(tblSQL, table.remove(tblX)) -- transfer one value to SQL table
if #tblX == 0 or #tblSQL > 999 then -- update this block of values
database:execute('DELETE FROM EventTable WHERE EventID IN (' .. table.concat(tblSQL, ',') .. ')')
tblSQL = {}
end
end
end
-- *********************************************************************
function UpdateRMTimeStamps(database, FileName)
-- reads list of changed individuals and updates RM timestamps accordingly
ProgressBarIncrement('Updating RM Timestamps')
local count = 0
local DataFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync List.txt'
if not fhfu.fileExists(DataFile) then return end
local S = fhLoadTextFile(DataFile)
local tblS = {}
for IDrm in S:gmatch('[^\r\n]+') do
table.insert(tblS, IDrm)
end
local tblSQL = {}
while #tblS > 0 do
table.insert(tblSQL, table.remove(tblS)) -- transfer one value to SQL table
if #tblS == 0 or #tblSQL > 999 then -- update this block of values
local SQL = 'UPDATE PersonTable SET UTCModDate = ' .. gblOptions.Now .. ' WHERE PersonID IN (' ..
table.concat(tblSQL, ',') .. ')'
database:execute(SQL)
tblSQL = {}
end
end
end
-- *********************************************************************
function UpdateAncestryList(database, FileName, tblUID)
-- reads list of changed individuals and updates Ancestry Table accordingly
ProgressBarIncrement('Updating Ancestry changed list')
local DataFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync List.txt'
local count = 0
if not fhfu.fileExists(DataFile) then return end
local S = fhLoadTextFile(DataFile)
local tblS = {}
for IDrm in S:gmatch('[^\r\n]+') do
table.insert(tblS, IDrm)
end
local SQL
local tblSQL = {}
while #tblS > 0 do
table.insert(tblSQL, table.remove(tblS)) -- transfer one value to SQL table
if #tblS == 0 or #tblSQL > 999 then -- update this block of values
local SQL = 'UPDATE AncestryTable SET Modified = 1, UTCModDate = ' .. gblOptions.Now ..
' WHERE rmID IN (' ..
table.concat(tblSQL, ',') .. ')'
database:execute(SQL)
tblSQL = {}
end
end
end
-- *********************************************************************
function MatchEvent(UID, Event, tblEvents)
-- finds Event in tblEvents, matched on UID (case insensitive)
if not tblEvents[UID] then return false end
for E, _ in pairs(tblEvents[UID]) do
if gblOptions.Case then
if E == Event then return true end
else
if E:lower() == Event:lower() then return true end
end
end
end
-- *********************************************************************
-- Compare and Update functions (reporting)
-- *********************************************************************
function CheckIndividuals(tblUID)
local tblAdd = {}
local tblDelete = {}
-- identify missing individuals
for UID, I in pairs(tblUID) do
if not I.IDrm then table.insert(tblAdd, I.p) end
if not I.IDfh then table.insert(tblDelete, I) end
end
-- sort into alphabetical order
tblAdd = SortIndividuals(tblAdd) -- sort table into name order
tblDelete = SortRMIndividuals(tblDelete)
return tblAdd, tblDelete
end
-- *********************************************************************
function SortIndividuals(tblI)
-- Sorts an indexed table of Individual pointers into name order
local tblT = {}
for _, p in ipairs(tblI) do
local id = fhGetItemText(p, '~.NAME:SURNAME') .. ':' .. fhGetItemText(p, '~.NAME:GIVEN_ALL') ..
':' .. fhGetRecordId(p)
table.insert(tblT, id)
end
table.sort(tblT)
local tblSorted = {}
for _, id in ipairs(tblT) do
local RIN = tonumber(id:match('%d+$'))
local pI = fhNewItemPtr()
pI:MoveToRecordById('INDI', RIN)
table.insert(tblSorted, pI:Clone())
end
tblT = nil
return tblSorted
end
-- *********************************************************************
function SortRMIndividuals(tblI)
-- Sorts an indexed table of Individual pointers into name order
local tblT = {}
for _, I in ipairs(tblI) do
local id = I.Surname
if id == '' then id = ' ' end
id = id .. ':' .. I.Given .. ':' .. I.IDrm
table.insert(tblT, id)
end
table.sort(tblT)
local tblSorted = {}
for _, id in ipairs(tblT) do
local IDrm = tonumber(id:match('%d+$'))
for _, I in ipairs(tblI) do
if IDrm == I.IDrm then
table.insert(tblSorted, I)
break
end
end
end
tblT = nil
return tblSorted
end
-- *********************************************************************
function SortChangedIndividuals(tblUID, tblUpdates)
-- Sorts table of Individuals with changes via an intemediate table
local tblT = {}
for UID, _ in pairs(tblUpdates) do
local pI = tblUID[UID].p
local SortKey = fhGetItemText(pI, '~.NAME:SURNAME') .. ',' .. fhGetItemText(pI, '~.NAME:GIVEN_ALL') ..
',' .. fhGetItemText(pI, '~.BIRT.DATE:YEAR') .. ',' ..
fhGetItemText(pI, '~.BIRT.DEAT:YEAR') .. ',' .. UID
table.insert(tblT, SortKey)
end
table.sort(tblT)
-- Match sort keys and add to final sorted table
local tblSorted = {}
for _, SortedKey in ipairs(tblT) do
local UID = SortedKey:match('%x+$')
local tblC = {}
tblC.UID = UID
table.sort(tblUpdates[UID])
tblC.Facts = tblUpdates[UID]
table.insert(tblSorted, tblC)
end
tblT = nil
return tblSorted
end
-- *********************************************************************
function SortFamilies(tblF)
-- returns ordered table of omitted families
local p = fhNewItemPtr()
local tblT = {}
local tblSorted = {}
for RIN, _ in pairs(tblF) do
p:MoveToRecordById('FAM', RIN)
local p1, p2 = GetFamilySpouses(p)
local tblF = {}
if p1:IsNotNull() then
table.insert(tblF, fhGetItemText(p1, '~.NAME:SURNAME'))
table.insert(tblF, fhGetItemText(p1, '~.NAME:GIVEN_ALL'))
end
if p2:IsNotNull() then
table.insert(tblF, fhGetItemText(p2, '~.NAME:SURNAME'))
table.insert(tblF, fhGetItemText(p2, '~.NAME:GIVEN_ALL'))
end
table.insert(tblF, fhGetRecordId(p))
table.insert(tblT, table.concat(tblF, ':'))
end
table.sort(tblT)
for _, id in ipairs(tblT) do
local RIN = tonumber(id:match('%d+$'))
local pF = fhNewItemPtr()
pF:MoveToRecordById('FAM', RIN)
table.insert(tblSorted, pF:Clone())
end
tblT = nil
return tblSorted
end
-- *********************************************************************
function AddFHRecord(p, rt)
-- record FH Record as either link or plain text
if gblOptions.Links then
rt:AddRecordLink(p)
else
rt:AddText(fhGetItemText(p, '~.NAME'))
end
end
-- *********************************************************************
function CreateRecordList(tblUID)
-- generate optional cross-reference table
local tblFH = {}
local tblRM = {}
local tblRMS = {}
local tblFHID = {}
local tblRMID = {}
if gblOptions.Table and gblOptions.TableExists then -- table generated already
local msg = 'Cross-reference table has been generated already and will not be duplicated.'
MessageBox(msg, 'OK', 'WARNING')
return
end
for UID, I in pairs(tblUID) do
table.insert(tblFH, I.p or '')
if not I.Given and not I.Surname then
table.insert(tblRM, '')
elseif I.Given == '' or I.Surname == '' then
table.insert(tblRM, I.Given .. I.Surname:upper())
else
table.insert(tblRM, I.Given .. ' ' .. I.Surname:upper())
end
table.insert(tblRMS, (I.Surname or '') .. ', ' .. (I.Given or ''))
table.insert(tblFHID, I.IDfh or '')
table.insert(tblRMID, I.IDrm or '')
end
fhOutputResultSetTitles('Match List')
fhOutputResultSetColumn('Record', 'item', tblFH, #tblFH, 140)
fhOutputResultSetColumn('FH ID', 'integer', tblFHID, #tblFHID, 40)
fhOutputResultSetColumn('RM ID', 'integer', tblRMID, #tblRMID, 40)
fhOutputResultSetColumn('RM Name', 'text', tblRM, #tblRM, 140)
fhOutputResultSetColumn('', 'text', tblRMS, #tblRMS, 140, 'align_left', 1, true, 'default', 'hide')
gblOptions.TableExists = true -- prevents generating a second table
end
-- *********************************************************************
-- GEDCOM export functions
-- *********************************************************************
function ExportGEDCOM()
local pI = fhNewItemPtr()
local pF = fhNewItemPtr()
local tblI = {} -- excluded individuals
local tblF = {} -- excluded families
local TotalI, TotalF, ExcludedI, ExcludedF = 0, 0, 0, 0
local count = 0
local tblOutput = {}
local tblFactsI, tblFactsF = DefineFacts()
-- warning message about incompatible export
if gblOptions.DisableCompat then
local msg = 'You have selected to disable RootsMagic/Ancestry compatibility for the GEDCOM ' ..
'export. While this improves compatibility with other applications, the output file ' ..
'should NOT be used to update a RootsMagic database.\n\n' ..
'Are you sure that you want to continue with the export?'
if MessageBox(msg, 'YESNO', 'WARNING', nil, '2') ~= 1 then return end
end
if gblOptions.Unchanged then
local msg = 'This partial GEDCOM export should be used only for updating the linked ' ..
'RootsMagic database.'
if MessageBox(msg, 'OKCANCEL', 'WARNING', nil, '2') ~= 1 then return end
end
-- get export file name
local filedlg = iup.filedlg{dialogtype = 'SAVE', title = 'Export GEDCOM File',
extfilter = 'GEDCOM files (*.ged)|*.ged|All Files (*.*)|*.*|',
file = fhGetContextInfo('CI_PROJECT_NAME') .. '.ged',
directory = fhfu.splitPath(gblOptions.GFile or '').parent, extdefault = 'ged'}
if gblOptions.Unchanged then filedlg.Title = 'Export GEDCOM Update File' end
filedlg:popup()
if filedlg.Status == '-1' then return end
local FileName = filedlg.Value
-- save file as default next time
gblOptions.GFile = FileName
-- Identify excluded individuals and store in table.
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
if not gblOptions.Unchanged then
tblI[fhGetRecordId(pI)] = IsExcluded(pI)
else
if not gblOptions.Unchanged.I[fhGetRecordId(pI)] then
tblI[fhGetRecordId(pI)] = true
end
end
TotalI = TotalI + 1
pI:MoveNext()
end
for I, _ in pairs(tblI) do ExcludedI = ExcludedI + 1 end
-- Identify excluded families and store in table.
pF:MoveToFirstRecord('FAM')
while pF:IsNotNull() do
if not gblOptions.Unchanged then
tblF[fhGetRecordId(pF)] = IsExcluded(pF, true)
else
if not (gblOptions.Unchanged.F and gblOptions.Unchanged.F[fhGetRecordId(pF)]) then
tblF[fhGetRecordId(pF)] = true
end
end
TotalF = TotalF + 1
pF:MoveNext()
end
for F, _ in pairs(tblF) do ExcludedF = ExcludedF + 1 end
-- Start progress bar
ProgressBarStart(TotalI + TotalF - ExcludedI - ExcludedF)
gblProgBar.Dialog.Title = 'Exporting GEDCOM file...'
gblProgBar.Action = 'Exporting GEDCOM file'
-- Write GEDCOM header
table.insert(tblOutput, '0 HEAD')
table.insert(tblOutput, '1 SOUR Family Historian')
table.insert(tblOutput, '1 GEDC')
table.insert(tblOutput, '2 VERS 5.5')
table.insert(tblOutput, '2 FORM LINEAGE-LINKED')
table.insert(tblOutput, '1 CHAR UTF-8')
table.insert(tblOutput, '1 DEST GED55')
-- Loop through all individuals, processing all non-excluded entries (turn off name case preference)
fhOverridePreference('SURNAMES_UPPERCASE', true, false)
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
if not tblI[fhGetRecordId(pI)] then
local p = fhNewItemPtr()
local pL = fhNewItemPtr()
table.insert(tblOutput, '0 @I' .. fhGetRecordId(pI) .. '@ INDI')
p:MoveTo(pI,'~.NAME')
if p:IsNull() then
-- give dummy name, as RM does not process unnamed individuals correctly
table.insert(tblOutput, '1 NAME ?')
end
while p:IsNotNull() do
if gblOptions.DisableCompat then
table.insert(tblOutput, '1 NAME ' .. fhGetValueAsText(p))
else
local surname = '/' .. fhGetItemText(p, '~:SURNAME') .. '/'
local given = fhGetItemText(p, '~:GIVEN_ALL')
if surname ~= '' and given ~= '' then
table.insert(tblOutput, '1 NAME ' .. given .. ' ' .. surname)
else
table.insert(tblOutput, '1 NAME ' .. given .. surname)
end
end
for _, Qualifier in ipairs({'NPFX', 'NSFX', 'NICK'}) do
local Q = fhGetItemText(p, '~.' .. Qualifier)
if Q ~= '' then table.insert(tblOutput, '2 ' .. Qualifier .. ' ' .. Q) end
end
p:MoveNext('SAME_TAG')
end
p:MoveTo(pI,'~.SEX')
if p:IsNotNull() then table.insert(tblOutput, '1 SEX ' ..
fhGetItemText(pI, '~.SEX'):sub(1, 1)) end
for _, Fact in ipairs(tblFactsI) do
local Tag = Fact.Tag
local Description = Fact.Description
p:MoveTo(pI, '~.' .. Tag)
while p:IsNotNull() do
if fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if Tag:sub(1,6) == '_ATTR-' or Tag:sub(1,5) == 'EVEN-' then -- custom fact
table.insert(tblOutput, '1 EVEN ' .. fhGetValueAsText(p))
table.insert(tblOutput, '2 TYPE ' .. Description)
elseif Tag == 'CENS' and not gblOptions.DisableCompat then
table.insert(tblOutput, '1 RESI') -- Ancestry compatibility
else
table.insert(tblOutput, '1 ' .. Tag .. ' ' .. fhGetValueAsText(p))
end
local pD = fhGetItemPtr(p,'~.DATE')
if pD:IsNotNull() then
table.insert(tblOutput, '2 DATE ' .. GetGEDCOMDate(pD))
end
local EventPlace = fhGetItemText(p, '~.PLAC')
if EventPlace ~= '' then table.insert(tblOutput, '2 PLAC ' .. EventPlace) end
end
p:MoveNext('SAME_TAG')
end
if Tag == 'DEAT' and fhGetItemPtr(pI, '~.DEAT'):IsNull() and
fhGetItemPtr(pI, '~._FLGS.__LIVING'):IsNull() then
table.insert(tblOutput, '1 DEAT Y') -- RM uses this format to denote non-living
end
end
pL:MoveTo(pI,'~.FAMC')
while pL:IsNotNull() do
p = fhGetValueAsLink(pL)
if not tblF[fhGetRecordId(p)] then -- exclude private families
table.insert(tblOutput, '1 FAMC @F' .. fhGetRecordId(p) .. '@')
end
pL:MoveNext('SAME_TAG')
end
pL:MoveTo(pI,'~.FAMS')
while pL:IsNotNull() do
p = fhGetValueAsLink(pL)
if not tblF[fhGetRecordId(p)] then -- exclude private individuals
table.insert(tblOutput, '1 FAMS @F' .. fhGetRecordId(p) .. '@')
end
pL:MoveNext('SAME_TAG')
end
p:MoveTo(pI,'~._UID') -- only export first value for RM compatibility
table.insert(tblOutput, '1 _UID ' .. FormatUID(fhGetValueAsText(p)))
end
count = count + 1
if count % 100 == 0 then
ProgressBarUpdate(count)
gblProgBar.bar.value = count
end
pI:MoveNext()
end
fhOverridePreference('SURNAMES_UPPERCASE', false)
-- Process non-private families
pF:MoveToFirstRecord('FAM')
while pF:IsNotNull() do
if not tblF[fhGetRecordId(pF)] then
local p = fhNewItemPtr()
table.insert(tblOutput, '0 @F' .. fhGetRecordId(pF) .. '@ FAM')
for _, Fact in ipairs(tblFactsF) do
local Tag = Fact.Tag
local Description = Fact.Description
p:MoveTo(pF, '~.' .. Tag)
while p:IsNotNull() do
if fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if Tag:sub(1,6) == '_ATTR-' or Tag:sub(1,5) == 'EVEN-' then -- custom fact
table.insert(tblOutput, '1 EVEN ' .. fhGetValueAsText(p))
table.insert(tblOutput, '2 TYPE ' .. Description)
elseif Tag == 'CENS' then
table.insert(tblOutput, '1 RESI') -- Ancestry compatibility
else
table.insert(tblOutput, '1 ' .. Tag .. ' ' .. fhGetValueAsText(p))
end
local pD = fhGetItemPtr(p,'~.DATE')
if pD:IsNotNull() then
table.insert(tblOutput, '2 DATE ' .. GetGEDCOMDate(pD))
end
local EventPlace = fhGetItemText(p, '~.PLAC')
if EventPlace ~= '' then table.insert(tblOutput, '2 PLAC ' .. EventPlace) end
end
p:MoveNext('SAME_TAG')
end
end
local pL1, pL2 = GetFamilySpouses(pF)
if pL1:IsNotNull() then
table.insert(tblOutput, '1 HUSB @I' .. fhGetRecordId(pL1) .. '@')
end
if pL2:IsNotNull() then
table.insert(tblOutput, '1 WIFE @I' .. fhGetRecordId(pL2) .. '@')
end
pL1:MoveTo(pF,'~.CHIL')
while pL1:IsNotNull() do
p = fhGetValueAsLink(pL1)
if not tblI[fhGetRecordId(p)] then -- exclude private individuals
table.insert(tblOutput, '1 CHIL @I' .. fhGetRecordId(p) .. '@')
local Frel, Mrel = GetParentRelationships(p, pF)
if Frel then table.insert(tblOutput, '2 _FREL ' .. Frel) end
if Mrel then table.insert(tblOutput, '2 _MREL ' .. Mrel) end
end
pL1:MoveNext('SAME_TAG')
end
end
count = count + 1
if count % 100 == 0 then
ProgressBarUpdate(count)
gblProgBar.bar.value = count
end
pF:MoveNext()
end
table.insert(tblOutput, '0 TRLR')
-- generate export note
if gblOptions.GEDCOM then
GEDCOMreport(tblI, tblF, TotalI, TotalF, ExcludedI, ExcludedF)
end
gblProgBar.Dialog:destroy()
gblProgBar.Dialog = nil
-- check export is not empty (e.g. by selecting an empty Ancestry Sync list)
if TotalI == ExcludedI and TotalF == ExcludedF then
local msg = 'GEDCOM export file is empty, and will not be saved.'
MessageBox(msg, 'OK', 'ERROR')
return
end
fhSaveTextFile(FileName, table.concat(tblOutput, '\n') .. '\n')
tblOutput = nil
collectgarbage('collect')
-- provide confirmation message
local msg
if gblOptions.Unchanged then
msg = 'File update completed.\n\n' .. TotalI - ExcludedI .. ' individuals and ' ..
TotalF - ExcludedF .. ' families written to file.'
else
msg = 'File export completed.\n\n' .. TotalI - ExcludedI .. ' individuals and ' ..
TotalF - ExcludedF .. ' families written to file.'
end
if TotalI - ExcludedI == 1 then msg = msg:gsub('individuals', 'individual') end
if TotalF - ExcludedF == 1 then msg = msg:gsub('families', 'family') end
if ExcludedI + ExcludedF > 0 then
msg = msg .. '\n\nExcluded individuals: ' .. ExcludedI
msg = msg .. '\nExcluded families: ' .. ExcludedF
end
MessageBox(msg, 'OK', 'INFORMATION')
end
-- *********************************************************************
function GetParentRelationships(pI, pF)
local found
local F, M = 'birth', 'birth'
local pL = fhGetItemPtr(pI, '~.FAMC')
while pL:IsNotNull() do
if fhGetValueAsLink(pL):IsSame(pF) then
found = true
break
end
pL:MoveNext('SAME_TAG')
end
if not found then return end
local pP = fhGetItemPtr(pL, '~.PEDI')
while pP:IsNotNull() do
local aa = fhGetValueAsText(pP)
if aa == 'Adopted' or aa == 'Adopted (father)' then F = 'adopted' end
if aa == 'Foster' or aa == 'Foster (father)' then F = 'foster' end
if aa == 'Step' or aa == 'Step (father)' then F = 'step' end
if aa == 'Adopted' or aa == 'Adopted (mother)' then M = 'adopted' end
if aa == 'Foster' or aa == 'Foster (mother)' then M = 'foster' end
if aa == 'Step' or aa == 'Step (mother)' then M = 'step' end
pP:MoveNext('SAME_TAG')
end
return F, M
end
-- *********************************************************************
function GetUpdateList()
-- get update file and compare with current file stamps
if gblOptions.Full then return end -- never use extract
local UpdateFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync Update.txt'
local S = fhLoadTextFile(UpdateFile)
if not S then return end
local FHold = tonumber(S:match('FH=(%d+)'))
local RMold = tonumber(S:match('RM=(%d+)'))
local RMnew = fhfu.getDateModified(gblOptions.File)
if RMold ~= RMnew or FHUpdated(FHold) then return end
-- extract is still valid, so proceed
local Individuals = S:match('I=(%C+)%c') or ''
local tblI = {}
for I in Individuals:gmatch('([^,]+)') do
tblI[tonumber(I)] = true
end
local Families = S:match('F=(%C+)%c') or ''
local tblF = {}
for F in Families:gmatch('([^,]+)') do
tblF[tonumber(F)] = true
end
return {I = tblI, F = tblF}
end
-- *********************************************************************
function SetUpdateList(tblUpdates, tblAdd, tblUID)
local tblI = {}
local tblF = {}
-- add new and updated individuals unconditionally
for UID, _ in pairs(tblUpdates) do
table.insert(tblI, tblUID[UID].IDfh)
end
for _, I in ipairs(tblAdd) do
table.insert(tblI, fhGetRecordId(I))
end
-- add their families unconditionally, including any spouses
for UID, _ in pairs(tblUpdates) do
local ID = tblUID[UID].IDfh
local pI = fhNewItemPtr()
local pF = fhNewItemPtr()
pI:MoveToRecordById('INDI', ID)
pF:MoveTo(pI, '~.FAMS')
while pF:IsNotNull() do
local pL = fhGetValueAsLink(pF)
table.insert(tblF, fhGetRecordId(pL))
local pS = fhNewItemPtr()
pS:MoveTo(pL, '~.~SPOU[1]>')
if fhGetRecordId(pS) ~= ID then
table.insert(tblI, fhGetRecordId(pS))
else
pS:MoveTo(pL, '~.~SPOU[2]>')
table.insert(tblI, fhGetRecordId(pS))
end
pF:MoveNext('SAME_TAG')
end
end
-- expand tables to include hooks to link with existing family in RM merge
for _, I in ipairs(tblAdd) do
local pFAMS = fhGetItemPtr(I, '~.FAMS')
while pFAMS:IsNotNull() do
local pF = fhGetValueAsLink(pFAMS)
if not IsExcluded(pF, true) then
table.insert(tblF, fhGetRecordId(pF))
end
local pH, pW = GetFamilySpouses(pF)
if pH:IsNotNull() and not pH:IsSame(I) and not IsExcluded(pH) then -- spouse in scope
table.insert(tblI, fhGetRecordId(pH))
elseif pW:IsNotNull() and not pW:IsSame(I) and not IsExcluded(pW) then -- spouse in scope
table.insert(tblI, fhGetRecordId(pW))
end
local pCHIL = fhGetItemPtr(pF, '~.CHIL')
while pCHIL:IsNotNull() do
local pC = fhGetValueAsLink(pCHIL)
if not IsExcluded(pC) then table.insert(tblI, fhGetRecordId(pC)) end
pCHIL:MoveNext('SAME_TAG')
end
pFAMS:MoveNext('SAME_TAG')
end
local pFAMC = fhGetItemPtr(I, '~.FAMC')
while pFAMC:IsNotNull() do
local pF = fhGetValueAsLink(pFAMC)
if not IsExcluded(pF, true) then
table.insert(tblF, fhGetRecordId(pF))
end
local pH, pW = GetFamilySpouses(pF)
if pH:IsNotNull() and not IsExcluded(pH) then table.insert(tblI, fhGetRecordId(pH)) end
if pW:IsNotNull() and not IsExcluded(pW) then table.insert(tblI, fhGetRecordId(pW)) end
pFAMC:MoveNext('SAME_TAG')
end
end
-- save timestamps and lists of records for extract
local UpdateFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync Update.txt'
local S = 'FH=' .. os.time() .. '\n' ..
'RM=' .. fhfu.getDateModified(gblOptions.File) .. '\n' ..
'I=' .. table.concat(tblI, ',') .. '\nF=' .. table.concat(tblF, ',') .. '\n'
fhSaveTextFile(UpdateFile, S)
end
-- *********************************************************************
function GEDCOMreport(tblI, tblF, TotalI, TotalF, PrivateI, PrivateF)
-- create Research Note to output result of GEDCOM export
local rt = fhNewRichText()
rt:AddText('Title:\tAncestry Sync – GEDCOM Export\n')
rt:AddText('Type:\tAncestry Sync\n')
rt:AddText('Date:\t' .. os.date('%d' .. ' ' .. '%b' .. ' ' .. '%Y') .. '\n')
rt:AddText('Status:\topen\n\n')
rt:AddText('')
rt:AddText('FH Project: | ' .. fhGetContextInfo('CI_PROJECT_NAME') .. ' (' ..
fhGetContextInfo('CI_PROJECT_FILE'):gsub('\\', '\\\\') .. '
')
rt:AddText('GEDCOM File: | ' .. gblOptions.GFile:gsub('\\', '\\\\') .. '
')
rt:AddText('\n\n')
rt:AddText('This Research Note summarises the result of the GEDCOM export from the ' ..
'Ancestry Synchronization plugin.\n\n')
rt:AddText('')
rt:AddText(' | Total | Exported | Excluded
')
rt:AddText('Individuals: | ' .. TotalI .. ' | ' .. TotalI - PrivateI .. '| ' .. PrivateI .. '
')
rt:AddText('Families: | ' .. TotalF .. ' | ' .. TotalF - PrivateF .. '| ' .. PrivateF .. '
')
rt:AddText('\n')
if PrivateI > 0 and not gblOptions.Unchanged then
rt:AddText('\nIndividuals excluded from export:\n\n')
-- copy omitted individuals to new table for easier sorting
local tblT = {}
for RIN, _ in pairs(tblI) do
local pI = fhNewItemPtr()
pI:MoveToRecordById('INDI', RIN)
table.insert(tblT, pI:Clone())
end
tblT = SortIndividuals(tblT)
for _, pI in ipairs(tblT) do
AddFHRecord(pI, rt)
rt:AddText(' (' .. IsExcluded(pI) .. ')\n')
end
end
if PrivateF > 0 and not gblOptions.Unchanged then
rt:AddText('\nFamilies excluded from export:\n\n')
tblF = SortFamilies(tblF)
for _, pF in ipairs(tblF) do
local p1, p2 = GetFamilySpouses(pF)
if p1:IsNotNull() then
AddFHRecord(p1, rt)
if IsExcluded(p1) then rt:AddText(' (' .. (IsExcluded(p1) or '') .. ')') end
else
rt:AddText('Unknown')
end
rt:AddText(' & ')
if p2:IsNotNull() then
AddFHRecord(p2, rt)
if IsExcluded(p2) then rt:AddText(' (' .. (IsExcluded(p2) or '') .. ')') end
else
rt:AddText('Unknown')
end
rt:AddText('\n')
end
end
if PrivateI + PrivateF == 0 then
rt:AddText('\nAll Individuals and Families exported to GEDCOM file.')
end
-- create Research Note from assembled content
local pRN = fhCreateItem('_RNOT')
local pT = fhGetItemPtr(pRN, '~.TEXT')
fhSetValueAsRichText(pT, rt)
fhUpdateDisplay()
end
-- *********************************************************************
-- Ancestry audit functions
-- *********************************************************************
function AuditAncestryGEDCOM()
-- lists defined errors in Ancestry GEDCOM export file
-- get Ancestry export file name
local filedlg = iup.filedlg{dialogtype = 'OPEN', title = 'Select Ancestry Export GEDCOM File',
directory = fhfu.splitPath(gblOptions.AFile or '').parent,
extfilter = 'GEDCOM files (*.ged)|*.ged|All Files (*.*)|*.*|'}
filedlg:popup()
if filedlg.Status == '-1' then return end
local FileName = filedlg.Value
gblOptions.AFile = FileName
local FileContents = fhLoadTextFile(FileName):gsub('\r\n', '\n') -- simple Unix endings
-- is this the correct file?
local _, RIN, _ = FileContents:match('(%c)3 RIN (%d+)(%c)')
if RIN ~= gblOptions.TreeID then
MessageBox('Incorrect GEDCOM file.', 'OK', 'ERROR')
return
end
-- correct known errors in file format
local NewFileContents = UpdateAncestryGEDCOM(FileContents)
-- modify Submitter record to confirm correct file when loading as new project
local S1 = '0 @SUBM1@ SUBM\n'
local S2 = '1 NAME Ancestry.com Member Trees Submitter\n'
local S3 = '1 NOTE FH Ancestry Sync Plugin\n'
if not NewFileContents:match(S1 .. S2 .. S3) then
NewFileContents = NewFileContents:gsub(S1 .. S2, S1 .. S2 .. S3, 1)
end
if NewFileContents ~= FileContents then
fhSaveTextFile(FileName, NewFileContents)
end
-- process data
local anID
local tblANCI = {} -- table for all Ancestry individuals
for Line in FileContents:gmatch('[^\r\n]+') do
if Line:match('^0') and anID then -- end of individual
anID = nil
end
if Line:match('^0 @I%d+@ INDI$') then -- start of new individual
anID = Line:match('^0 @I(%d+)@ INDI$')
tblANCI[anID] = {}
tblANCI[anID].Sex = {}
end
if Line:match('^1 SEX (%u)$') and anID then
table.insert(tblANCI[anID].Sex, Line:match('^1 SEX (%u)$'))
end
if Line:match('^1 MARR') and anID then
tblANCI[anID].MARR = true
end
if Line:match('^1 DIV') and anID then
tblANCI[anID].DIV = true
end
end
-- get table of Ancestry IDs and names
local tblANC = GetAncestryLinks()
-- rearrange to link Ancestry ID with name
local tblANCid = {}
for I, tblANid in pairs(tblANC) do
for _, anID in ipairs(tblANid) do
tblANCid[anID] = I
end
end
-- count how many records affected by extra SEX, MARR, or DIV tags
local CountS, CountM, CountD = 0, 0, 0
for anID, issue in pairs(tblANCI) do
if #issue.Sex > 1 then CountS = CountS + 1 end
if issue.MARR then CountM = CountM + 1 end
if issue.DIV then CountD = CountD + 1 end
end
-- identify individuals with multiple genders or family facts
local rt = fhNewRichText()
rt:AddText('Title:\tAncestry Audit - GEDCOM Export Issues\n')
rt:AddText('Type:\tAncestry Sync\n')
rt:AddText('Date:\t' .. os.date('%d' .. ' ' .. '%b' .. ' ' .. '%Y') .. '\n')
rt:AddText('Status:\topen\n\n')
rt:AddText('')
rt:AddText('FH Project: | ' .. fhGetContextInfo('CI_PROJECT_NAME') .. ' (' ..
fhGetContextInfo('CI_PROJECT_FILE'):gsub('\\', '\\\\') .. ')
')
rt:AddText('RM File: | ' .. gblOptions.File:gsub('\\', '\\\\') .. '
')
rt:AddText('Ancestry Tree: |
')
rt:AddText('GEDCOM File: | ' .. gblOptions.AFile:gsub('\\', '\\\\') .. '
')
rt:AddText('\n\n')
rt:AddText('This Research Note lists Individuals in the linked Ancestry tree where errors in the ' ..
'GEDCOM file have been noted (usually created as an artefact of TreeShare). Click on ' ..
'the links to edit the individual directly within Ancestry.\n')
if CountS > 0 then
rt:AddText('\nMultiple Gender Facts - correct in Ancestry, then repeat the GEDCOM export\n\n')
for anID, issues in pairs(tblANCI) do
if #issues.Sex > 1 then
rt:AddText('\n')
end
end
end
if CountM > 0 then
rt:AddText("\nMarriage Tag associated with Individual - review Individual's marriages in " ..
'Ancestry, then repeat the GEDCOM export if changes made\n\n')
for anID, issues in pairs(tblANCI) do
if issues.MARR then
rt:AddText('\n')
end
end
end
if CountD > 0 then
rt:AddText("\nDivorce Tag associated with Individual - review Individual's divorce in " ..
'Ancestry, then repeat the GEDCOM export if changes made\n\n')
for anID, issues in pairs(tblANCI) do
if issues.DIV then
rt:AddText('\n')
end
end
end
if CountS + CountM + CountD == 0 then
rt:AddText('\nNo GEDCOM issues detected in linked Ancestry Tree.')
end
local pRN = fhCreateItem('_RNOT')
local pT = fhGetItemPtr(pRN, '~.TEXT')
fhSetValueAsRichText(pT, rt)
fhUpdateDisplay()
local endmsg = 'Ancestry check completed and reported as new Research Note.'
if CountS + CountM + CountD == 0 then
endmsg = endmsg .. '\n\nNo multiple Gender Facts or extra Marriage or Divorce tags detected in ' ..
'linked Ancestry Tree.\n\nYou can now import the Ancestry GEDCOM file into Family ' ..
'Historian as a new Project to complete the audit.'
end
MessageBox(endmsg, 'OK', 'INFORMATION')
end
-- *********************************************************************
function AuditAncestryTree()
-- get data from linked RM file
local tblAncestry = GetAncestryLinks()
-- compile report
local rt = fhNewRichText()
rt:AddText('Title:\tAncestry Audit - Individuals\n')
rt:AddText('Type:\tAncestry Sync\n')
rt:AddText('Date:\t' .. os.date('%d' .. ' ' .. '%b' .. ' ' .. '%Y') .. '\n')
rt:AddText('Status:\topen\n\n')
rt:AddText('')
rt:AddText('FH Project: | ' .. fhGetContextInfo('CI_PROJECT_NAME') .. ' (' ..
fhGetContextInfo('CI_PROJECT_FILE'):gsub('\\', '\\\\') .. ')
')
rt:AddText('RM File: | ' .. gblOptions.File:gsub('\\', '\\\\') .. '
')
if gblOptions.TreeID then
rt:AddText('Ancestry Tree: |
')
end
rt:AddText('\n\n')
rt:AddText('This Research Note lists Individuals in the linked RootsMagic file that are either ' ..
'missing from the associated Ancestry tree or have been duplicated due to limitations in ' ..
'the TreeShare process.\n\n')
local Missing, Duplicate
for _, anc in pairs(tblAncestry) do
if #anc == 0 then Missing = true end
if #anc > 1 then Duplicate = true end
end
if Missing then
rt:AddText('Missing Individuals - re-run TreeShare to upload to Ancestry\n\n')
for rm, anc in pairs(tblAncestry) do
if #anc == 0 then rt:AddText(rm .. '\n') end
end
rt:AddText('\n')
end
if Duplicate then
rt:AddText('Duplicated Individuals - click on either hyperlink and merge the two ' ..
'records on Ancestry, then re-run TreeShare to update RootsMagic\n\n')
for rm, anc in pairs(tblAncestry) do
if #anc > 1 then
rt:AddText(rm)
for n, anID in ipairs(anc) do
rt:AddText(' - ')
end
rt:AddText('\n')
end
end
end
if not Missing and not Duplicate then
rt:AddText('No missing or duplicate individuals detected in linked Ancestry tree.')
end
local pRN = fhCreateItem('_RNOT')
local pT = fhGetItemPtr(pRN, '~.TEXT')
fhSetValueAsRichText(pT, rt)
fhUpdateDisplay()
local endmsg = 'Ancestry check completed and reported as new Research Note.'
if not Missing and not Duplicate then
endmsg = endmsg .. '\n\nNo missing or duplicate individuals detected in linked Ancestry tree.'
end
MessageBox(endmsg, 'OK', 'INFORMATION')
end
-- *********************************************************************
function GetAncestryLinks()
-- get table of names and Ancestry IDs from RM file
local database, SQLfile = OpenDatabase(gblOptions.File)
if not database then return end
local tblANC = {}
local SQL = 'SELECT UniqueID, Surname, Given, PersonID, anID ancID FROM PersonTable P ' ..
'JOIN NameTable N ON N.OwnerID = P.PersonID and N.IsPrimary = 1 ' ..
'LEFT JOIN AncestryTable A ON P.PersonID = A.rmID'
local ResultSet = database:select(SQL)
for I in ResultSet:rows() do
local PersonID = I.PersonID|0
local Record = I.Given .. ' ' .. I.Surname .. ' (RM' .. PersonID .. ')'
if not tblANC[Record] then tblANC[Record] = {} end
if I.ancID then
local ID = I.ancID:match('^%d+')
table.insert(tblANC[Record], ID)
end
end
database:close()
ResultSet = nil
collectgarbage('collect')
fhfu.deleteFile(SQLfile)
return tblANC
end
-- *********************************************************************
function IsAuditTree()
-- returns true if Submitter is Ancestry member tree
local p = fhNewItemPtr()
p:MoveToFirstRecord('SUBM')
local C1 = (fhGetItemText(p, '~.NAME') == 'Ancestry.com Member Trees Submitter')
local C2 = C1 and (fhGetItemText(p, '~.NOTE2') == 'FH Ancestry Sync Plugin')
return C1, C2
end
-- *********************************************************************
function UpdateAncestryGEDCOM(FileContents)
-- correct Custom ID (user-defined event in Ancestry)
FileContents = FileContents:gsub('1 EVEN\n2 TYPE Ref #\n2 NOTE', '1 REFN')
-- correct double dates
local tblS = {}
for Line in FileContents:gmatch('[^\r\n]+') do
if Line:match('%a%a%a%s%d%d%d%d%/%d$') then -- double dates
local y = tonumber(Line:sub(-4, -3))
if y == 99 then
Line = Line:sub(1, Line:len()-1) .. '00'
else
Line = Line:sub(1, Line:len()-1) .. (y+1)
end
end
if Line:match('^1 UID %w+$') then -- UniqueID
Line = '1 _UID ' .. Line:sub(7,14) .. '-' .. Line:sub(15,18) .. '-' ..
Line:sub(19,22) .. '-' .. Line:sub(23,26) .. '-' .. Line:sub(27)
end
table.insert(tblS, Line)
end
return table.concat(tblS, '\n') .. '\n'
end
-- *********************************************************************
-- General admin functions
-- *********************************************************************
function CountIndividuals()
local pI = fhNewItemPtr()
local n = 0
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
n = n + 1
pI:MoveNext()
end
return n
end
-- *********************************************************************
function CheckUIDs()
-- check that all Individuals have a UID assigned
local function GenerateUID()
local tblT = {}
for i = 1, 32 do
local num = math.random(0, 15)
table.insert(tblT, string.format('%X', num))
end
tblT[13] = '4' -- denotes version 4 (random numbers)
local var = math.random(8, 11) -- 8 to B
tblT[17] = string.format('%X', var)
table.insert(tblT, 21, '-')
table.insert(tblT, 17, '-')
table.insert(tblT, 13, '-')
table.insert(tblT, 9, '-')
return(table.concat(tblT))
end
-- prescreen prior to making any changes
local invalid, multiple, missing
local pI = fhNewItemPtr()
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
local pUID = fhGetItemPtr(pI, '~._UID')
if pUID:IsNull() then
missing = true
break
end
local UID = fhGetValueAsText(pUID)
local U1, U2, U3, U4, U5 = UID:match('^(%x+)%-(%x+)%-(%x+)%-(%x+)%-(%x+)$')
if not (U1 and U2 and U3 and U4 and U5) or U1:len() ~= 8 or U2:len() ~= 4 or
U3:len() ~= 4 or U4:len() ~= 4 or U5:len() ~= 12 then
invalid = true
break
end
pUID:MoveNext('SAME_TAG')
if pUID:IsNotNull() then multiple = true end
pI:MoveNext()
end
if invalid then
local msg = 'One or more Individuals has an invalid Unique ID. Please correct before proceeding'
MessageBox(msg, 'OK', 'ERROR')
return
end
if missing then
local msg = 'Do you want the plugin to generate and add missing Unique ID values to Individuals?'
if MessageBox(msg, 'OKCANCEL', 'QUESTION') ~= 1 then return end
end
-- generate any missing UID values
if missing then
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
local UID = fhGetItemText(pI, '~._UID')
if UID == '' then
local pUID = fhCreateItem('_UID', pI)
fhSetValueAsText(pUID, GenerateUID())
end
pI:MoveNext()
end
fhUpdateDisplay()
end
if multiple then
local msg = 'This project has one or more individuals with multiple UniqueID values. ' ..
'Only the first value is processed by this plugin, which may cause problems when ' ..
'comparing the project with the linked RootsMagic file.'
MessageBox(msg, 'OK', 'WARNING')
end
return true -- no missing UID values
end
-- *********************************************************************
function FormatRMDate(S)
-- converts RM proprietory date format to FH date
local Date = ''
local tblMonths = {'January', 'February', 'March', 'April', 'May', 'June', 'July',
'August', 'September', 'October', 'November', 'December'}
if S == '.' then return '' end -- null date
if S:sub(1,1) == 'T' then -- date phrase
S = '"' .. S:sub(2) .. '"' -- convert to FH format
return S
end
if S:sub(13,13) == 'C' or S:sub(13,13) == 'A' then Date = Date .. 'circa '
elseif S:sub(2,2) == 'A' then Date = Date .. 'after '
elseif S:sub(2,2) == 'B' then Date = Date .. 'before '
elseif S:sub(2,2) == 'F' then Date = Date .. 'from '
elseif S:sub(2,2) == 'S' then Date = Date .. 'from '
elseif S:sub(2,2) == 'R' then Date = Date .. 'between ' end
if S:sub(10,10) ~= '0' then Date = Date .. S:sub(10,10) end
if S:sub(10,11) ~= '00' then Date = Date .. S:sub(11,11) .. ' ' end
if S:sub(8,9) ~= '00' then Date = Date .. tblMonths[tonumber(S:sub(8,9))] .. ' ' end
if S:sub(4,7) ~= '0000' then Date = Date .. S:sub(4,7) end
if S:sub(12,12) == '/' then
Date = Date .. '/' .. tostring(tonumber(S:sub(4,7)) + 1):sub(3,4) end
if S:sub(2,2) == 'S' then Date = Date .. ' to '
elseif S:sub(2,2) == 'R' then Date = Date .. ' and ' end
if S:sub(21,21) ~= '0' then Date = Date .. S:sub(21,21) end
if S:sub(21,22) ~= '00' then Date = Date .. S:sub(22,22) .. ' ' end
if S:sub(19,20) ~= '00' then Date = Date .. tblMonths[tonumber(S:sub(19,20))] .. ' ' end
if S:sub(15,18) ~= '0000' then Date = Date .. S:sub(15,18) end
if S:sub(23,23) == '/' and S:sub(15,22) ~= '00000000' then -- slightly different format in RM7 & RM8
Date = Date .. '/' .. tostring(tonumber(S:sub(15,18)) + 1):sub(3,4) end
if S:sub(13,13) == 'L' then Date = Date .. ' (calculated)'
elseif S:sub(13,13) == 'E' then Date = Date .. ' (estimated)' end
-- convert to Date object and back to avoid formatting errors (circa, Q dates options)
local dtRM = fhNewDate()
dtRM:SetValueAsText(Date, true)
return dtRM:GetValueAsText()
end
-- *********************************************************************
function FormatUID(UID)
-- converts FH UID format to GEDCOM L format used by RM (32+4)
UID = UID:gsub('-', '')
-- calculate checksum using published method
local a = 0
local b = 0
for i = 1, 31, 2 do
local byte = UID:sub(i, i + 1)
local value = tonumber('0x' .. byte)
a = a + value
b = b + a
end
local cs1 = string.format('%x', a)
local cs2 = string.format('%x', b)
local checksum = cs1:sub(-2) .. cs2:sub(-2)
-- use same case for checksum as for main string
if UID:upper() == UID then checksum = checksum:upper() end
return UID .. checksum
end
-- *********************************************************************
function GetFamilySpouses(pF)
-- convert FH assymetric storage of single sex couples to symmetric
local pH1 = fhGetItemPtr(pF, '~.HUSB[1]')
local pH2 = fhGetItemPtr(pF, '~.HUSB[2]')
local pW1 = fhGetItemPtr(pF, '~.WIFE[1]')
local pW2 = fhGetItemPtr(pF, '~.WIFE[2]')
if pH2:IsNull() and pW2:IsNull() then
return fhGetValueAsLink(pH1), fhGetValueAsLink(pW1)
elseif pH2:IsNotNull() then
return fhGetValueAsLink(pH1), fhGetValueAsLink(pH2)
elseif pW2:IsNotNull() then
return fhGetValueAsLink(pW2), fhGetValueAsLink(pW1)
end
end
-- *********************************************************************
function GetGEDCOMDate(pD)
-- converts FH date to GEDCOM format
local dtD = fhGetValueAsDate(pD)
local S = dtD:GetDisplayText('COMPACT')
-- strip out quotes from date phrases
if S:match('^%"') and S:match('%"$') then
return S:sub(2,-2)
end
S = S:gsub('c%.', 'ABT')
S = S:gsub('btw', 'BET')
S = S:gsub('frm', 'FROM')
local I = S:find('(est)')
if I then S = 'EST ' .. S:sub(1, I - 3) end
I = S:find('(cal)')
if I then S = 'CAL ' .. S:sub(1, I - 3) end
I = S:find('Q1')
if I then S = 'BET JAN ' .. S:sub(4) .. ' AND MAR ' .. S:sub(4) end
I = S:find('Q2')
if I then S = 'BET APR ' .. S:sub(4) .. ' AND JUN ' .. S:sub(4) end
I = S:find('Q3')
if I then S = 'BET JUL ' .. S:sub(4) .. ' AND SEP ' .. S:sub(4) end
I = S:find('Q4')
if I then S = 'BET OCT ' .. S:sub(4) .. ' AND DEC ' .. S:sub(4) end
return S:upper()
end
-- ************************************************************************** --
function GetRegistryKey(key)
local sh = luacom.CreateObject 'WScript.Shell'
local ans
if pcall(function () ans = sh:RegRead(key) end) then
return ans
else
return nil,true
end
end
-- *********************************************************************
function GetUID(pI)
local UID = fhGetItemText(pI, '~._UID')
return FormatUID(UID)
end
-- *********************************************************************
function FHUpdated(RefTime)
-- returns true if any Individual or Family records have been updated since RefTime
local p = fhNewItemPtr()
for _, RecType in ipairs({'INDI', 'FAM'}) do
p:MoveToFirstRecord(RecType)
while p:IsNotNull() do
local D, H, M = fhCallBuiltInFunction('LastUpdated', p)
if not D:IsNull() then
local T = os.time{year=D:GetYear(), month=D:GetMonth(), day=D:GetDay(), hour=H, min=M}
if T > RefTime then return true end
end
p:MoveNext()
end
end
end
-- *********************************************************************
function MessageBox(Message, Buttons, Icon, Title, Default)
-- replaces built-in function with custom version containing more options
-- set message
local msgdlg = iup.messagedlg{value = Message, buttons = Buttons, dialogtype = Icon,
title = Title or 'Ancestry Synchronization', buttondefault = Default}
-- display message box and return selection
msgdlg:popup()
return tonumber(msgdlg.ButtonResponse)
end
-- *********************************************************************
function ProgressBarIncrement(Title)
-- increment progress bar
gblProgBar.Action = Title
gblProgBar.Dialog.title = Title .. '...'
gblProgBar.bar.Value = gblProgBar.bar.Value + 1
-- write log
local step = tonumber(gblProgBar.bar.Value)
local log = step .. ',' .. Title .. ',' .. os.time() - gblProgBar.Start ..
',' .. string.format('%.0f', (collectgarbage('count')))
table.insert(gblProgBar.Log, log)
fhSaveTextFile(gblProgBar.LogFile, table.concat(gblProgBar.Log, '\n') .. '\n')
end
-- *********************************************************************
function ProgressBarStart(Max)
-- create and display a simple progress bar, and store in a global table
gblProgBar = {}
gblProgBar.bar = iup.progressbar{max = Max; rastersize = '400x30'}
gblProgBar.vbox = iup.vbox{gblProgBar.bar; gap = 20, alignment = 'acenter', margin = '5x15'}
gblProgBar.Dialog = iup.dialog{gblProgBar.vbox; title = '', dialogframe = 'Yes', border = 'Yes',
menubox = 'No'}
gblProgBar.Start = os.time()
gblProgBar.Response = os.time()
gblProgBar.Log = {}
gblProgBar.LogFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync Log.csv'
table.insert(gblProgBar.Log, 'Step,Action,Time,RAM')
gblProgBar.Dialog:showxy(iup.CENTER, iup.CENTER) -- Put up Progress Display
end
-- *********************************************************************
function ProgressBarUpdate(count, descriptor)
-- update progress bar with ongoing count
gblProgBar.Dialog.title = gblProgBar.Action .. ' (' .. count .. ' ' ..
(descriptor or 'Records') .. ')...'
local now = os.time()
if now - gblProgBar.Response > 3 then
fhExhibitResponsiveness()
gblProgBar.Response = now
end
end
-- *********************************************************************
main()
--[[
@Title: Ancestry Synchronization
@Type: Standard
@Author: Mark Draper
@Contributor John Elvin
@Version: 2.6
@LastUpdated: 4 May 2026
@Licence: This plugin is copyright (c) 2026 Mark Draper and is licensed under the MIT License which
is hereby incorporated by reference (see https://pluginstore.family-historian.co.uk/fh-plugin-licence)
@Description: Produces a fixed GEDCOM export, suitable for loading into RootsMagic 11 or later for
subsequent synchronization with Ancestry. Reads RootsMagic database directly and generates
a Research Note listing all differences. Deletes Facts from RootsMagic that are
not in the current Family Historian Project. Supports a customisable subset of Facts with
standard Date and Place fields, but no comments, sources, or media. Living individuals
are excluded from the output by default but can be incorporated if required.
]]
--[[
Developed from the FHUG plugin, Family Historian - RootsMagic - Ancestry Sync
Version 1.0 (Feb 2023)
- Initial Plugin Store version.
Version 1.1 (May 2023)
- Interim fix for date phrases containing quotation characters
Version 2.0 (Jun 2023)
- New main menu with details of RM and Ancestry links
- Improved messages and reports, including link to Ancestry tree
- New Ancestry audit functions and Research Note report
- Simplified comparison of parents and spouse, so family sequence is ignored
(improved compatibility with Ancestry auditing)
- New plugin options and improved options form
- basic BMD export
- optional case sensitive place and attribute value matching (previously always enforced)
- RM backup now automatic, but only if file changed
- Unmatching names relegated to Alternate Name in RM for quicker deletion
- Now supports same-sex families and surname-first names
- Improved compatibility with RM7
- Improved handling of names
- Improved cross-reference table (sorted by RM name)
- Improved handling of date phrases for full compatibility between apps
- Improved message boxes (using IUP box, not FH function)
- Additional checks when starting to screen out invalid operation
- Now requires FH 7.0.15 or later due to changes in fhFileUtils()
Version 2.0.1 (Jun 2023)
- Fix for variability in RM options file structure
Version 2.1 (Sep 2023)
- New option to base individual selection on Ancestry Sync list
- New option to disable RM/Ancestry compatibility for GEDCOM export
- New GEDCOM export Research note
- Improved menu display that keeps previous menus visible but inactive
- Now permits export of blank names (RM can import them but not create them, so works ok)
- Added extra message to close file prior to early RM update if sex change detected
- Fixed bug that stopped parent check running (simplified code for table initialisation)
- Fixed display of surnames with punctuation characters by more selective use of overwriting
case preference (let FH do the formatting)
- Fixed bug affecting export of surname-first names (forced to given-first for RM compatibility)
- Fixed typo affecting two-female family records
Version 2.2 (Nov 2023)
- More extensive memory management to handle very large projects (>25k records)
- More detailed progress bar, kept open throughout the entire Compare or Update process
- Much faster processing of bulk changes in RM by passing records in batches and using SQL 'IN' statement
- Automatic export of only changed and related records to speed up RM Share Merge
- Improved internal processing of large datasets
Version 2.3 (Jan 2024)
- Removed support for RM7/8 following Ancestry login changes
- Various minor bug fixes and code tidying
Version 2.4 (Aug 2024)
- Fixed bug with un-named individuals
- Checks for multiple UniqueID values
- New standard format options file
- Resetting RM file with changed project name now optional
- Optional import of custom fact list
- Emulator warning
Version 2.4.1 (Aug 2024)
- Fixed bug not exporting changed family records in GEDCOM update
Version 2.5 (May 2025)
- Corrected FH/RM comparison where name has suffix
- Support for multi-monitor systems
- Checks for errors in ini file when loading
- Enhanced tool tips
Version 2.5.1 (Sep 2025)
- Updated to support RM11
Version 2.6 (May 2026)
- Modified menu form
- Remove loading old format ini file (no longer required)
- Adopted/Foster/Step parental qualifiers supported
- Simplified options with standard Ancestry domain and no RM version-specific labelling
- Export Living flag to GEDCOM file in RM syntax
- LIMIT clause for Ancestry Tree ID
- New option to inhibit partial GEDCOM export
- Uses os.tmpfile() for RM working copy to guarantee ASCII name
- reworked garbage collection and memory management
- Reports RM file corruption
- Calculates missing UniqueID values
- Checks existing UIDs for consistent format
- RM file version check and warning
]]
fhInitialise(7, 0, 15)
require('luacom')
require('fhSQL')
require('iuplua')
lfs = require('lfs')
fhu = require('fhUtils')
fhfu = require('fhFileUtils')
fhu.setIupDefaults()
FSO = luacom.CreateObject("Scripting.FileSystemObject")
-- *********************************************************************
-- Main, menu and Fact selection functions
-- *********************************************************************
function main()
-- check for emulator
if fhfu.folderExists('Z:\\bin') and fhfu.folderExists('Z:\\etc') then
local msg = 'Family Historian does not support linking to external databases via plugins when ' ..
'running on Mac or Linux systems.'
MessageBox(msg, 'OK', 'ERROR', 'Emulator Incompatibility Warning')
return
end
-- check not running in Standalone GEDCOM mode
if fhGetContextInfo('CI_APP_MODE') ~= 'Project Mode' then
local msg = 'This plugin can only be run from within a Family Historian project.'
MessageBox(msg, 'OK', 'ERROR')
return
end
-- check not an Ancestry GEDCOM export that has not been processed
local IsExport, IsProcessed = IsAuditTree()
if IsExport and not IsProcessed then
local msg = 'Project is derived from an Ancestry GEDCOM export that has not been processed by the ' ..
"plugin.\n\nReload your main project and run 'Process Ancestry GEDCOM Export File' from " ..
'the main menu to prepare the file for import into Family Historian.'
MessageBox(msg, 'OK', 'ERROR')
return
end
-- check project size
if CountIndividuals() > 2^15 then
local msg = 'This plugin may experience memory issues with very large projects. ' ..
'A future update will remedy this.'
MessageBox(msg, 'OK', 'WARNING')
end
-- check Project has complete UID set
if not IsExport and not CheckUIDs() then return end
-- get plugin options
gblOptions = GetOptions()
-- exit if user cancelled
if gblOptions == -1 then return end
-- present menu
Menu()
-- delete list of changed records if no longer valid
if not gblOptions.Unchanged then
local UpdateFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Sync Update.txt'
fhfu.deleteFile(UpdateFile)
end
-- save options prior to quitting
if gblOptions then SaveOptions() end
end
-- *********************************************************************
function Menu()
-- generate main plugin menu
-- define link elements
local lblRM = iup.label{title = 'Linked RootsMagic file:'}
local lblRMfile = iup.label{expand = 'HORIZONTAL'}
local lblRMupdated = iup.label{title = 'File last accessed:'}
local lblRMfileupdated = iup.label{expand = 'HORIZONTAL'}
local lblANC = iup.label{title = 'Linked Ancestry tree:'}
local lnkANC = iup.link{expand = 'HORIZONTAL'}
local gboxLinks = iup.gridbox{lblRM, lblRMfile, lblRMupdated, lblRMfileupdated, lblANC, lnkANC;
numdiv = 2, sizecol = -1, sizelin = -1,
gapcol = 5, gaplin = 5, margin = '10x'}
local btnSelect = iup.button{title = 'Select', padding = '10x3',
action = function(self) SelectRMFile() UpdateMenu() end,
TipBalloon = 'YES', TipBalloonTitle = 'Link RootsMagic Database',
TipBalloonTitleIcon = '1',
tip = 'Select RootsMagic file linked to this project'}
local vboxLinks = iup.vbox{gboxLinks, btnSelect; alignment = 'ACENTER', gap = 10, margin = '10x10'}
local fraLinks = iup.frame{vboxLinks; title = 'Links'}
-- define RM elements
local btnExport = iup.button{title = 'Export GEDCOM File',
action = function(self)
ExportGEDCOM()
UpdateMenu()
iup.SetFocus(btnSelect)
end,
TipBalloon = 'YES', TipBalloonTitle = 'Export GEDCOM File',
TipBalloonTitleIcon = '1',
tip = 'Export customized GEDCOM file to create or \nupdate linked RootsMagic database'}
local btnCompare = iup.button{title = 'Compare Project with Linked RM File', padding = '5x3',
TipBalloon = 'YES', TipBalloonTitle = 'Compare RootsMagic Database',
TipBalloonTitleIcon = '1',
tip = 'Generate list of differences between current Project and linked RootsMagic database'}
local btnUpdate = iup.button{title = 'Update Linked RM File',
TipBalloon = 'YES', TipBalloonTitle = 'Update RootsMagic Database',
TipBalloonTitleIcon = '2',
tip = 'Update linked RootsMagic database to reflect current Project contents'}
local vboxRM = iup.vbox{btnCompare, btnExport, btnUpdate;
normalizesize = 'BOTH', gap = 10, margin = '10x10'}
local fraRM = iup.frame{vboxRM; title = 'RootsMagic Synchronization'}
-- define Ancestry elements
local btnDuplicates = iup.button{title = 'Check For Missing or Duplicate Records', padding = '5x3',
action = function(self) AuditAncestryTree() UpdateMenu() end,
TipBalloon = 'YES', TipBalloonTitle = 'Audit Linked Ancestry Tree',
TipBalloonTitleIcon = '3',
tip = 'Compare linked Ancestry tree with RootsMagic database to\n' ..
'check for missing records or accidental duplication'}
local btnGEDCOM = iup.button{title = 'Process Ancestry GEDCOM Export File',
action = function(self) AuditAncestryGEDCOM() UpdateMenu() end,
TipBalloon = 'YES', TipBalloonTitle = 'Remove Ancestry Export Errors',
TipBalloonTitleIcon = '1',
tip = 'Identify duplicate Sex data in Ancestry export GEDCOM, and reformat\n' ..
'file ready for import to Family Historian as new Project'}
local btnAudit = iup.button{title = 'Compare Audit Project with RM File', padding = '5x3',
action = function(self) AuditRMFile(false) UpdateMenu() end, -- active = 'NO',
TipBalloon = 'YES', TipBalloonTitle = 'Audit Linked Ancestry Tree',
TipBalloonTitleIcon = '1',
tip = 'Generate list of differences between current Ancestry-derived \n' ..
'Project and linked RootsMagic database'}
if not gblOptions.TreeID then
btnDuplicates.Active = 'NO'
btnGEDCOM.Active = 'NO'
end
local vboxANC = iup.vbox{btnDuplicates, btnGEDCOM, btnAudit;
normalizesize = 'BOTH', gap = 10; margin = '10x10'}
local fraANC = iup.frame{vboxANC; title = 'Audit Ancestry Tree'}
-- create common buttons
local url = 'https://pluginstore.family-historian.co.uk/page/help/ancestry-synchronization'
local btnOptions = iup.button{title = 'Options',
action = function(self) SelectOptions() UpdateMenu() end,
TipBalloon = 'YES', TipBalloonTitle = 'Options',
TipBalloonTitleIcon = '1',
tip = 'Configure plugin options', padding = '10x3'}
local btnHelp = iup.button{title = 'Help',
action = function(self) fhShellExecute(url) end,
TipBalloon = 'YES', TipBalloonTitle = 'Display Plugin Help',
TipBalloonTitleIcon = '1',
tip = 'Display plugin help page'}
local btnCancel = iup.button{title = 'Close',
action = function(self) return iup.CLOSE end,
TipBalloon = 'YES', TipBalloonTitle = 'Close Plugin',
TipBalloonTitleIcon = '1',
tip = 'Close plugin'}
local buttons = iup.hbox{iup.fill{}, btnOptions, btnHelp, btnCancel, iup.fill{};
normalizesize = 'BOTH', margin = 'x20', gap = 50}
local MainForm
function UpdateMenu()
-- display current RM file if defined
-- (using FSO directly is simpler than converting fhFileUtils epoch time)
if gblOptions.File then
lblRMfile.Title = fhfu.splitPath(gblOptions.File).filename
lblRMfileupdated.Title = FSO:GetFile(gblOptions.File).DateLastModified
lblRMfile.Tip = gblOptions.File
if gblOptions.TreeID then
local TreeURL = gblOptions.URL .. 'tree/' .. gblOptions.TreeID
lnkANC.Title = TreeURL
lnkANC.url = TreeURL
lnkANC.Active = 'YES'
else
lnkANC.Title = ''
lnkANC.Active = 'NO'
end
end
-- is a list of changed records available?
gblOptions.Unchanged = GetUpdateList()
-- modify buttons according to current context
if IsAuditTree() then
fraRM.Active = 'NO'
btnDuplicates.Active = 'NO'
btnGEDCOM.Active = 'NO'
btnAudit.Active = YesNo(gblOptions.File)
else
btnCompare.Active = YesNo(gblOptions.File)
btnUpdate.Active = YesNo(gblOptions.File)
btnAudit.Active = 'NO'
btnDuplicates.Active = YesNo(gblOptions.TreeID)
btnGEDCOM.Active = YesNo(gblOptions.TreeID)
end
if gblOptions.Unchanged and not gblOptions.Full then
btnExport.Title = 'Export GEDCOM Update File'
else
btnExport.Title = 'Export GEDCOM File'
end
MainForm.BringFront = 'YES'
end
function YesNo(b) if b then return 'YES' else return 'NO' end end
function btnCompare:action()
AuditRMFile(false)
UpdateMenu()
end
function btnUpdate:action()
AuditRMFile(true)
UpdateMenu()
end
-- assemble the form
local vboxForm = iup.vbox{fraLinks, iup.hbox{fraRM, iup.fill{}, fraANC;
gap = 10, margin = '10x10'}, buttons; gap = 10, margin = '10x10'}
MainForm = iup.dialog{vboxForm; resize = 'NO', minbox = 'NO', maxbox = 'NO',
title = 'Ancestry Synchronization (' .. gblOptions.Version .. ')'}
MainForm:map() -- ensures layout is preserved for changes in RM file version
UpdateMenu()
if gblOptions.File then
MainForm.StartFocus = btnCompare
else
MainForm.StartFocus = btnExport
end
iup.SetAttribute(MainForm, 'NATIVEPARENT', fhGetContextInfo('CI_PARENT_HWND'))
MainForm:popup()
end
-- *********************************************************************
function DefineFacts()
--[[
Define a common set of Facts for both the initial GEDCOM export and sync with RM.
There is also an option to import a comma-separated list of facts (Tag, Description).
See the help file for more detailed information.
]]
local tblI = {}
local tblF = {}
if gblOptions.BMD then
table.insert(tblI, {Tag = 'BIRT', Description = 'Birth'})
table.insert(tblF, {Tag = 'MARR', Description = 'Marriage'})
table.insert(tblI, {Tag = 'DEAT', Description = 'Death'})
else
-- Individual Facts (custom or standard list)
local FactFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Synchronization Facts.csv'
if fhfu.fileExists(FactFile) then
local Facts = fhLoadTextFile(FactFile)
for Fact in Facts:gmatch('[^\r\n]+') do
local Tag, Description = Fact:match('^([%w%-%_]+)%,([%g%s]+)$')
table.insert(tblI, {Tag = Tag, Description = Description})
end
else
table.insert(tblI, {Tag = 'BIRT', Description = 'Birth'})
table.insert(tblI, {Tag = 'BAPM', Description = 'Baptism'})
table.insert(tblI, {Tag = 'CHR', Description = 'Chr'})
table.insert(tblI, {Tag = 'OCCU', Description = 'Occupation'})
table.insert(tblI, {Tag = 'CENS', Description = 'Census'})
table.insert(tblI, {Tag = 'RESI', Description = 'Residence'})
table.insert(tblI, {Tag = 'EMIG', Description = 'Emigration'})
table.insert(tblI, {Tag = 'IMMI', Description = 'Immigration'})
table.insert(tblI, {Tag = 'NATU', Description = 'Naturalization'})
table.insert(tblI, {Tag = 'RETI', Description = 'Retirement'})
table.insert(tblI, {Tag = 'DEAT', Description = 'Death'})
table.insert(tblI, {Tag = 'BURI', Description = 'Burial'})
table.insert(tblI, {Tag = 'CREM', Description = 'Cremation'})
table.insert(tblI, {Tag = 'PROB', Description = 'Probate'})
table.insert(tblI, {Tag = 'REFN', Description = 'Ref #'})
end
-- Family Facts (do not add additional facts, due to limitation in TreeShare)
table.insert(tblF, {Tag = 'MARR', Description = 'Marriage'})
table.insert(tblF, {Tag = 'DIV', Description = 'Divorce'})
end
return tblI, tblF
end
-- *********************************************************************
function CheckAncestrySyncList()
-- checks for presence of Ancestry Sync list
local GedcomFile = fhGetContextInfo('CI_GEDCOM_FILE')
local Gedcom = fhLoadTextFile(GedcomFile)
return Gedcom:match('1 _LIST Ancestry Sync\r\n')
end
-- *********************************************************************
function IsExcluded(p, family)
-- returns true for out of scope individual or family records
if not family then
local tblP = {}
if fhGetItemText(p, '~._FLGS.__PRIVATE') == 'Y' then table.insert(tblP, 'Private') end
if fhGetItemText(p, '~._FLGS.__LIVING') == 'Y' and not gblOptions.Living then
table.insert(tblP, 'Living') end
if gblOptions.List and not fhCallBuiltInFunction('IsInList', p, 'Ancestry Sync') then
table.insert(tblP, 'List') end
if fhGetItemText(p, '~._UID') == '' then
table.insert(tblP, 'Missing UID')
end
if #tblP > 0 then return table.concat(tblP, ',') end
else
local pH, pW = GetFamilySpouses(p)
-- two visible parents
if pH:IsNotNull() and not IsExcluded(pH) and pW:IsNotNull() and not IsExcluded(pW) then return end
-- no visible parents
if (pH:IsNull() or IsExcluded(pH)) and (pW:IsNull() or IsExcluded(pW)) then return true end
-- one visible parent, so return false if a visible child, true otherwise
local pCHIL = fhGetItemPtr(p, '~.CHIL')
while pCHIL:IsNotNull() do
local pC = fhGetValueAsLink(pCHIL)
if not IsExcluded(pC) then return end
pCHIL:MoveNext('SAME_TAG')
end
return true
end
end
-- *********************************************************************
-- Options functions
-- *********************************************************************
function GetOptions()
local OptionsFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Synchronization.ini'
local tblO = {}
for _, F in ipairs({'Project', 'File', 'GFile', 'AFile'}) do
local File = fhGetIniFileValue(OptionsFile, 'Files', F, 'text')
if File ~= '' then tblO[F] = File end
end
for _, O in ipairs({'Living', 'List', 'BMD', 'Case', 'GEDCOM', 'Full', 'Links', 'Table'}) do
local Option = fhGetIniFileValue(OptionsFile, 'Options', O, 'bool')
if Option then tblO[O] = true end
end
-- check project matches (case-insensitive matching, as it is Windows!)
if tblO.Project then
local StoredProject = fhfu.splitPath(tblO.Project).basename
local StoredPath = fhfu.splitPath(tblO.Project).parent
local Project = fhGetContextInfo('CI_PROJECT_NAME')
local Path = fhfu.splitPath(fhGetContextInfo('CI_PROJECT_FILE')).parent
if StoredProject:lower() ~= Project:lower() then
if StoredPath:lower() ~= Path:lower() then
StoredProject = StoredPath .. '\\' .. StoredProject
Project = Path .. '\\' .. Project
end
local msg = 'Project name differs from stored value. Do you want to reset the RootsMagic ' ..
'file?\n\nProject name: ' .. Project .. '\n\nStored Project: ' .. StoredProject
local Response = MessageBox(msg, 'YESNOCANCEL', 'WARNING')
if Response == 1 then
tblO.File = nil
tblO.GFile = nil
tblO.AFile = nil
elseif Response == 3 then
return
end
end
end
-- is filename valid?
if tblO.File and not (tblO.File):match('%.rmtree$') then
local msg = 'Invalid file name.'
MessageBox(msg, 'OK', 'WARNING')
tblO.File = nil
end
-- does tree file exist on this PC?
if tblO.File and not fhfu.fileExists(tblO.File) then
local msg = 'Specified RootsMagic file is not available on this PC. File name will be reset.'
if MessageBox(msg, 'OKCANCEL', 'WARNING') ~= 1 then return -1 end
tblO.File = nil
tblO.GFile = nil
tblO.AFile = nil
end
-- check RM file if defined
if tblO.File and not CheckRMVersion(tblO.File) then
tblO.File = nil
end
-- get TreeID for the specified tree file
if tblO.File then
local TreeID = GetTreeID(tblO.File)
if TreeID then
tblO.URL = 'https://www.ancestry.com/family-tree/'
tblO.TreeID = TreeID
end
end
-- get timestamp and convert to RM format (days since 31 Dec 1899)
tblO.Now = os.time()/86400 + 25569
tblO.Version = '2.6'
return tblO
end
-- *********************************************************************
function SelectOptions()
-- create options menu
local optLiving = iup.toggle{title = ' Include Individuals marked as Living', expand = 'HORIZONTAL'}
local optList = iup.toggle{title = ' Only Individuals in Ancestry Sync list', expand = 'HORIZONTAL'}
local optBMD = iup.toggle{title = ' Birth, Marriage && Death Facts only', expand = 'HORIZONTAL'}
local vbox1 = iup.vbox{optLiving, optList, optBMD; gap = 10, margin = '10x10'}
local fra1 = iup.frame{vbox1; title = 'Selection options'}
local optCompat = iup.toggle{title = ' Disable RM/Ancestry compatibility for this session',
expand = 'HORIZONTAL'}
local optFull = iup.toggle{title = ' Always export full GEDCOM file', expand = 'HORIZONTAL'}
local vbox2 = iup.vbox{optCompat, optFull; gap = 10, margin = '10x10'}
local fra2 = iup.frame{vbox2; title = 'Export options'}
local optCase = iup.toggle{title = ' Case-sensitive Fact matching', expand = 'HORIZONTAL'}
local vbox3 = iup.vbox{optCase; gap = 10, margin = '10x10'}
local fra3 = iup.frame{vbox3; title = 'Matching options'}
local optGEDCOM = iup.toggle{title = ' Generate GEDCOM export Research Note', expand = 'HORIZONTAL'}
local optLinks = iup.toggle{title = ' Display Family Historian Individuals as Links',
expand = 'HORIZONTAL'}
local optTable = iup.toggle{title = ' Generate cross-reference table on Update', expand = 'HORIZONTAL'}
local vbox4 = iup.vbox{optGEDCOM, optLinks, optTable; gap = 10, margin = '10x10'}
local fra4 = iup.frame{vbox4; title = 'Reporting options'}
local btnOK = iup.button{title = 'OK',
tip = 'Close window and update options'}
local btnCancel = iup.button{title = 'Cancel', padding = '10x3',
action = function(self) return iup.CLOSE end,
tip = 'Close window and leave options unchanged'}
local buttons = iup.hbox{iup.fill{}, btnOK, btnCancel, iup.fill{};
normalizesize = 'BOTH', gap = 50}
local vbox1 = iup.vbox{fra1, fra2; gap = 10, margin = '10x10'}
local vbox2 = iup.vbox{fra3, fra4; gap = 10, margin = '10x10'}
local hbox = iup.hbox{vbox1, vbox2}
local vbox = iup.vbox{hbox, buttons; gap = 10, margin = '10x10'}
local dialog = iup.dialog{vbox; resize = 'No', minbox = 'No', maxbox = 'No',
title = 'Project Synchronization Options'}
function btnOK:action()
gblOptions.Living = optLiving.Value == 'ON'
gblOptions.DisableCompat = optCompat.Value == 'ON'
gblOptions.List = optList.Value == 'ON'
gblOptions.BMD = optBMD.Value == 'ON'
gblOptions.Case = optCase.Value == 'ON'
gblOptions.GEDCOM = optGEDCOM.Value == 'ON'
gblOptions.Full = optFull.Value == 'ON'
gblOptions.Links = optLinks.Value == 'ON'
gblOptions.Table = optTable.Value == 'ON'
return iup.CLOSE
end
-- populate current options
if gblOptions.Living then optLiving.Value = 'ON' end
if not CheckAncestrySyncList() then -- Ancestry Sync list not in project
optList.Value = 'OFF'
optList.Active = 'NO'
gblOptions.List = nil
elseif gblOptions.List then
optList.Value = 'ON'
end
if gblOptions.DisableCompat then optCompat.Value = 'ON' end
if gblOptions.BMD then optBMD.Value = 'ON' end
if gblOptions.Case then optCase.Value = 'ON' end
if gblOptions.GEDCOM then optGEDCOM.Value = 'ON' end
if gblOptions.Full then optFull.Value = 'ON' end
if gblOptions.Links then optLinks.Value = 'ON' end
if gblOptions.Table then optTable.Value = 'ON' end
local FactFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Synchronization Facts.csv'
if fhfu.fileExists(FactFile) then
fra1.Title = 'Selection Options (Custom Fact List)'
end
-- wait for user input
dialog:popup()
end
-- *********************************************************************
function SaveOptions()
-- save current options to disk
local dir = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data'
if not fhfu.folderExists(dir) then fhfu.createFolder(dir) end
local OptionsFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') ..
'\\Plugin Data\\Ancestry Synchronization.ini'
-- create as Unicode to accept any file path
if not fhSaveTextFile(OptionsFile, '[Files]\n', 'UTF-16LE') then
MessageBox('Cannot create options file', 'OK', 'ERROR')
end
fhSetIniFileValue(OptionsFile, 'Files', 'Project', 'text', fhGetContextInfo('CI_PROJECT_FILE'))
for _, F in ipairs({'File', 'GFile', 'AFile'}) do
if gblOptions[F] then fhSetIniFileValue(OptionsFile, 'Files', F, 'text', gblOptions[F]) end
end
for _, O in ipairs({'Living', 'List', 'BMD', 'Case', 'GEDCOM', 'Full', 'Links', 'Table'}) do
if gblOptions[O] then fhSetIniFileValue(OptionsFile, 'Options', O, 'bool', gblOptions[O]) end
end
end
-- *********************************************************************
-- RM database functions
-- *********************************************************************
function SelectRMFile()
-- warn if GEDCOM not yet exported
if not gblOptions.GFile then
local msg = 'You have not yet exported a GEDCOM file for input into RootsMagic. ' ..
'Are you sure that you want to link a file before doing that?'
if MessageBox(msg, 'OKCANCEL', 'QUESTION', 'Confirm File Link', 2) ~= 1 then return end
end
local filedlg = iup.filedlg{dialogtype = 'OPEN', title = 'Open RootsMagic File',
directory = fhfu.splitPath(gblOptions.File or '').parent,
extfilter = 'RootsMagic Database|*.rmtree|All Files|*.*|'}
filedlg:popup()
if filedlg.Status == '-1' then return end
if not (filedlg.Value):match('%.rmtree$') then return end
-- check database version
if not CheckRMVersion(filedlg.Value) then return end
-- update file admin
gblOptions.File = filedlg.Value
gblOptions.URL = 'https://www.ancestry.com/family-tree/'
gblOptions.TreeID = GetTreeID(filedlg.Value)
end
-- *********************************************************************
function CheckRMVersion(FileName)
local database, SQLFile = OpenDatabase(FileName)
if not database then return end
local SQL = "select substr(DataRec, instr(DataRec,'') + 9, 4) Version, " ..
"substr(DataRec, instr(DataRec,'') + 11, 3) SchemaVersion from ConfigTable"
local ResultSet = database:select(SQL)
local VersionInfo = ResultSet:fetch()
local version = tonumber(VersionInfo.Version)
if not version or version == 6000 then
local msg = 'This plugin does not support RM7 or RM8. Please upgrade to the latest version.'
MessageBox(msg, 'OK', 'ERROR')
return
elseif version == 9000 or version == 1000 then
local msg = 'With effect from May 2026, TreeShare is only supported in RootsMagic 11.1 or later ' ..
'due to the introducion of a new Ancestry API. This plugin will synchronize with RM9 and ' ..
'RM10 databases, but they will not be able to link to Ancestry.\n\n' ..
'TreeShare settings are preserved when upgrading an ' ..
'older database by loading into a supported version of RootsMagic.'
MessageBox(msg, 'OK', 'WARNING')
end
return true
end
-- *********************************************************************
function OpenDatabase(FileName)
-- create copy of RM database file for manipulation (guaranteed ANSI compatibility)
local SQLfile = os.tmpname()
if not fhfu.copyFile(FileName, SQLfile, true) then
local msg = 'Cannot create local copy of RootsMagic file for processing.'
MessageBox(msg, 'OK', 'ERROR')
return
end
local database = fhSQL.connectSQLite(SQLfile)
return database, SQLfile
end
-- *********************************************************************
function GetTreeID(FileName)
-- get Tree ID from RM file
local database, SQLFile = OpenDatabase(FileName)
if not database then return end
SQL = 'SELECT anID FROM AncestryTable LIMIT 1'
ResultSet = database:select(SQL)
local anID = ''
for I in ResultSet:rows() do
anID = I.anID
end
local TreeID = anID:match('^%d+%:%d+%:(%d+)$')
if anID ~= '' and not TreeID then
local msg = 'Cannot determine URL of linked Ancestry tree. ' ..
'RootsMagic database file may be corrupted.'
MessageBox(msg, 'OK', 'WARNING')
end
database:close()
fhfu.deleteFile(SQLfile)
return TreeID
end
-- *********************************************************************
-- Compare and Update functions (evaluation)
-- *********************************************************************
function AuditRMFile(Update)
-- confirm update
if Update then
local msg = 'This option will update your RootsMagic database and cannot be undone using ' ..
'Edit > Undo Plugin Updates as it involves changes to an external file. ' ..
'Are you sure this is what you want to do?\n\nPlease ensure that the database ' ..
'file is not open in RootsMagic.'
if MessageBox(msg, 'YESNO', 'WARNING', nil, 2) ~= 1 then return end
end
local FileName = gblOptions.File
local database, SQLfile = OpenDatabase(FileName)
if not database then return end
-- get RM timestamp before any changes are made
local T = os.date('*t', lfs.attributes(SQLfile, 'modification'))
local TimeStamp = string.format('%04d-%02d-%02d_%02d%02d', T.year, T.month, T.day, T.hour, T.min)
local Tstart = lfs.attributes(SQLfile, 'modification')
-- Read in tables of Facts that are in scope
local tblIndividualFacts, tblFamilyFacts = DefineFacts()
-- Display progress bar
ProgressBarStart(20 + (#tblIndividualFacts + #tblFamilyFacts) * 3)
-- get Individuals
local tblFHI, tblRMI, tblUID = GetIndividuals(database)
-- get Families
local tblFHF = GetFHFamilies()
-- check for duplicate UID
local tblDuplicateUID = CheckDuplicateUID(database)
-- now start comparing facts (including family relationships) for individuals.
local tblUpdates = {}
-- compare living flags
if not IsAuditTree() then
local AlertLiving = CheckLivingFlags(database, tblUID, tblUpdates, Update)
end
-- compare spouses
CheckSpouses(database, tblUID, tblUpdates)
-- compare parents
if CheckParents(database, tblUID, tblFHI, tblFHF, tblUpdates) == -1 then
return
end
-- check names and sex
if Update then
CheckNames(database, tblFHI, tblUpdates, true)
end
CheckNames(database, tblFHI, tblUpdates, false)
if CheckSex(database, tblUID, tblFHI, tblUpdates, Update) and not Update and not IsAuditTree() then
-- alert if difference noted
local msg = "At least one change has been noted in an Individual's recorded Sex.\n\n" ..
'You are strongly recommended to update the RootsMagic file to reflect this change now ' ..
'in order to prevent issues with merging records of different sex.\n\n' ..
'Implement this update?'
if MessageBox(msg, 'YESNO', 'WARNING') == 1 then
MessageBox('Please ensure that the linked file is not open in RootsMagic before clicking on OK.',
'OK', 'WARNING')
CheckSex(database, tblUID, tblFHI, tblUpdates, true)
end
end
-- check Individual Facts (Fact name is RM name, not FH name)
for _, Fact in ipairs(tblIndividualFacts) do
CheckIndividualFact(database, tblUID, tblUpdates, Fact, Update)
end
-- check Family Facts
for _, Fact in ipairs(tblFamilyFacts) do
CheckFamilyFact(database, tblFHI, tblRMI, tblUID, tblFHF, tblUpdates, Fact, Update)
end
-- check for redundant events
CheckRedundantEvents(database, tblRMI, tblUID, tblUpdates, Update)
-- save or process list of changes to update RM timestamps and Ancestry "changed records" list
local UpdateFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync List.txt'
if not Update then -- generate list of changed individuals and save to disk
local tblU = {}
for UID, _ in pairs(tblUpdates) do
table.insert(tblU, tblUID[UID].IDrm)
end
if #tblU > 0 then
fhSaveTextFile(UpdateFile, table.concat(tblU, '\n'))
end
else -- update RM timestamps
UpdateRMTimeStamps(database, SQLfile)
UpdateAncestryList(database, SQLfile, tblUID)
fhfu.deleteFile(UpdateFile)
end
-- finished with RM, so connection can be closed
database:close()
-- create Research Note to output results
ProgressBarIncrement('Preparing Report')
local rt = fhNewRichText()
if IsAuditTree() then
rt:AddText('Title:\tRootsMagic - Ancestry Audit Guide\n')
elseif Update then
rt:AddText('Title:\tRootsMagic Update Guide\n')
else
rt:AddText('Title:\tRootsMagic - Ancestry TreeShare Update Guide\n')
end
rt:AddText('Type:\tAncestry Sync\n')
rt:AddText('Date:\t' .. os.date('%d' .. ' ' .. '%b' .. ' ' .. '%Y') .. '\n')
rt:AddText('Status:\topen\n')
rt:AddText('Ver:\t' .. gblOptions.Version .. '\n\n')
rt:AddText('')
rt:AddText('FH Project: | ' .. fhGetContextInfo('CI_PROJECT_NAME') .. ' (' ..
fhGetContextInfo('CI_PROJECT_FILE'):gsub('\\', '\\\\') .. '
')
rt:AddText('RM File: | ' .. FileName:gsub('\\', '\\\\') .. '
')
if gblOptions.TreeID then
rt:AddText('Ancestry Tree: |
')
end
rt:AddText('\n\n')
if IsAuditTree() then
rt:AddText('This Research Note lists all differences between the nominated RootsMagic file and ' ..
'the current Project. If you have completed the RootsMagic and Ancestry updates, it ' ..
'represents the events that should be reviewed within TreeShare to ensure that the ' ..
'Ancestry tree is a true match to your project. See the ' ..
' ' ..
'for more details of the auditing process.\n\n')
elseif Update then
rt:AddText('This Research Note lists all remaining differences between the nominated RootsMagic ' ..
'file and the current Project that cannot be processed automatically by the plugin. ' ..
'Make these changes in RootsMagic prior to running TreeShare to upload all changes to ' ..
'Ancestry.\n\n')
else
rt:AddText('This Research Note lists all differences between the nominated RootsMagic file and ' ..
'the current Project. If the RM-Ancestry sync is currently up to date, this is the list ' ..
'of changes that will need to be uploaded to Ancestry using RootsMagic TreeShare once ' ..
'the RootsMagic database has been updated.\n\n')
end
-- record counts
local FHI = 0
for _,_ in pairs(tblFHI) do FHI = FHI + 1 end
local RMI = 0
for _,_ in pairs(tblRMI) do RMI = RMI + 1 end
rt:AddText('FH Individuals: \t' .. FHI .. '\n')
rt:AddText('RM Individuals: \t' .. RMI .. '\n')
-- which Individuals are missing from RM/Ancestry?
local tblAdd, tblDelete = CheckIndividuals(tblUID)
if #tblAdd > 0 then
rt:AddText('\nNew Individuals to be added to RootsMagic:\n\n')
for _, pI in ipairs(tblAdd) do
AddFHRecord(pI, rt)
rt:AddText(' (FH' .. fhGetRecordId(pI) .. ')\n')
end
end
-- which Individuals are missing from FH?
if #tblDelete > 0 then
if not IsAuditTree() then
rt:AddText('\nIndividuals to be deleted from RootsMagic:\n\n')
else
rt:AddText('\nIndividuals with missing UniqueID in Ancestry export (may also impact reported differences):\n\n')
end
for _, I in ipairs(tblDelete) do
if I.Given == '' or I.Surname == '' then
rt:AddText(I.Given .. (I.Surname):upper() .. ' (RM' .. I.IDrm .. ')\n')
else
rt:AddText(I.Given .. ' ' .. (I.Surname):upper() .. ' (RM' .. I.IDrm .. ')\n')
end
end
end
-- count and report changed individuals
local ChangedIndividuals = 0
for _, _ in pairs(tblUpdates) do ChangedIndividuals = ChangedIndividuals + 1 end
if ChangedIndividuals > 0 then
local tblUpdates = SortChangedIndividuals(tblUID, tblUpdates)
rt:AddText('\nDifferences in Individual Records:\n\n')
for _, I in ipairs(tblUpdates) do
local UID = I.UID
AddFHRecord(tblUID[UID].p, rt)
rt:AddText(' (FH' .. tblUID[UID].IDfh .. '/RM' .. tblUID[UID].IDrm .. ') - ')
local PreviousItem = ''
local tblT = {}
for _, Item in ipairs(I.Facts) do
if Item ~= PreviousItem then table.insert(tblT, Item) end
PreviousItem = Item
end
rt:AddText(table.concat(tblT, ', ') .. '\n')
end
end
-- report duplicate individuals
if #tblDuplicateUID > 0 then
rt:AddText('\nDuplicate Individuals in RootsMagic:\n\n')
rt:AddText('These are duplicate individuals in the RootsMagic database that arise from a ' ..
'failed merge process. This is most commonly caused by a change in recorded sex, ' ..
'as records can only be merged if they are of the same sex. Please amend the ' ..
'incorrect sex in RootsMagic and manually merge the two records prior to ' ..
'rerunning the plugin.\n\n')
for _, I in ipairs(tblDuplicateUID) do
AddFHRecord(tblUID[I].p, rt)
rt:AddText(' (FH' .. tblUID[I].IDfh .. '/RM' .. tblUID[I].IDrm .. ')')
end
rt:AddText('\n')
end
-- alert to changes in Living status
if AlertLiving then
rt:AddText('\nNOTE:\n\nRootsMagic TreeShare may not detect a change in Living status ' ..
'when syncing with Ancestry. Please ensure that you check the relevant Ancestry ' ..
'record carefully to ensure that living individual privacy is protected.\n')
end
-- alert to RM deletions
if #tblDelete > 0 and Update then
rt:AddText('\nNOTE:\n\nWhere individuals are to be deleted, you may find it easier to ' ..
'delete the relevant individuals first, then re-run the Update process. Deleting an ' ..
'individual in either RootsMagic or Ancestry also deletes all their facts and ' ..
'relationships, so some of the differences reported here may no longer be relevant.\n')
end
-- do databases match?
local match = (FHI == RMI and #tblAdd + #tblDelete + ChangedIndividuals == 0)
-- generate list of changed records for smaller GEDCOM file and quicker RM merge
if match then
rt:AddText('\nNo differences identified.')
elseif not Update then
SetUpdateList(tblUpdates, tblAdd, tblUID)
end
-- create Research Note from assembled content
local pRN = fhCreateItem('_RNOT')
local pT = fhGetItemPtr(pRN, '~.TEXT')
fhSetValueAsRichText(pT, rt)
-- backup RM database before updating (if updated)
if lfs.attributes(SQLfile, 'modification') > Tstart then
local Path = fhfu.splitPath(FileName)
local BackupFile = Path.parent .. '\\~' .. Path.filename .. '.' .. TimeStamp .. '.bak'
if not fhfu.copyFile(FileName, BackupFile, true) then
local msg = 'RootsMagic backup failed. File not updated.'
MessageBox(msg, 'OK', 'ERROR')
return
end
if not fhfu.copyFile(SQLfile, FileName, true) then
local msg = 'RootsMagic update failed.'
MessageBox(msg, 'OK', 'ERROR')
return
end
end
fhfu.deleteFile(SQLfile)
-- save audit result and close progress bar now all complete
gblProgBar.Dialog:destroy()
gblProgBar = nil
fhUpdateDisplay()
-- generate record list
if Update and gblOptions.Table then CreateRecordList(tblUID) end
-- clear large tables
tblFHI = nil
tblRMI = nil
tblUID = nil
tblFHF = nil
collectgarbage('collect')
-- display confirmation
local endmsg
if Update then
endmsg = 'RootsMagic file update completed and reported as new Research Note.'
else
endmsg = 'RootsMagic comparison completed and reported as new Research Note.'
end
if match then
if Update then
endmsg = endmsg .. '\n\nNo remaining differences identified.'
else
endmsg = endmsg .. '\n\nNo differences identified.'
end
end
MessageBox(endmsg, 'OK', 'INFORMATION')
end
-- *********************************************************************
function GetIndividuals(database)
local tblFHI = {}
local tblRMI = {}
local tblUID = {}
local pI = fhNewItemPtr()
local count = 0
-- get FH records
ProgressBarIncrement('Getting FH Individuals')
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
if not IsExcluded(pI) then
local ID = fhGetRecordId(pI)
local UID = GetUID(pI)
tblFHI[ID] = {}
tblFHI[ID].p = pI:Clone()
tblFHI[ID].UID = UID
tblUID[UID] = {}
tblUID[UID].IDfh = ID
tblUID[UID].p = pI:Clone()
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
pI:MoveNext()
end
-- get RM records
ProgressBarIncrement('Getting RM Individuals')
count = 0
SQL = 'SELECT UniqueID, PersonID, Surname, Given ' ..
'FROM PersonTable, NameTable WHERE PersonID = OwnerID and IsPrimary = 1'
ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local ID = tonumber(p.PersonID)|0
local UID = p.UniqueID
tblRMI[ID] = {}
tblRMI[ID].Given = p.Given
tblRMI[ID].Surname = p.Surname:upper()
tblRMI[ID].UID = UID
if not tblUID[UID] then tblUID[UID] = {} end
tblUID[UID].IDrm = ID
tblUID[UID].Given = p.Given
tblUID[UID].Surname = p.Surname
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
collectgarbage('collect')
return tblFHI, tblRMI, tblUID
end
-- *********************************************************************
function CheckDuplicateUID(database)
local tblT = {}
local SQL = 'SELECT UniqueID FROM PersonTable GROUP BY UniqueID HAVING COUNT(*) > 1'
local ResultSet = database:select(SQL)
for P in ResultSet:rows() do
table.insert(tblT, P.UniqueID)
end
return tblT
end
-- *********************************************************************
function GetFHFamilies()
local p = fhNewItemPtr()
local pF = fhNewItemPtr()
local tblFHF = {}
local count = 0
ProgressBarIncrement('Getting FH Families')
pF:MoveToFirstRecord('FAM')
while pF:IsNotNull() do
if not IsExcluded(pF, true) then
local pH, pW = GetFamilySpouses(pF)
local ID = fhGetRecordId(pF)
tblFHF[ID] = {}
tblFHF[ID].p = pF:Clone()
if pH:IsNotNull() and not IsExcluded(pH) then tblFHF[ID].IDh = fhGetRecordId(pH) end
if pW:IsNotNull() and not IsExcluded(pW) then tblFHF[ID].IDw = fhGetRecordId(pW) end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
pF:MoveNext()
end
return tblFHF
end
-- *********************************************************************
function CheckLivingFlags(database, tblUID, tblUpdates, Update)
local tblFH = {}
local tblRM = {}
local alert
local count = 0
-- get FH Living flags
ProgressBarIncrement('Getting FH Living flags')
for UID, I in pairs(tblUID) do
if I.IDfh and fhGetItemText(I.p, '~._FLGS.__LIVING') == 'Y' then
tblFH[UID] = true
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM Living flags
ProgressBarIncrement('Getting RM Living flags')
count = 0
local SQL = 'SELECT UniqueID FROM PersonTable WHERE Living = 1'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
tblRM[p.UniqueID] = true
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- update RM flags to match FH
ProgressBarIncrement('Comparing Living flags')
count = 0
local tblSQL = {}
local tblSetLiving = {}
local tblClearLiving = {}
for UID, I in pairs(tblUID) do
if I.IDrm then
local change
if tblUID[UID].IDfh and tblFH[UID] and not tblRM[UID] then
table.insert(tblSetLiving, I.IDrm)
change = true
elseif tblUID[UID].IDfh and not tblFH[UID] and tblRM[UID] then
table.insert(tblClearLiving, I.IDrm)
change = true
end
if change and not Update then -- record the difference
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], 'Living Flag')
alert = true
end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
if Update then -- remove the differences
while #tblSetLiving > 0 do
table.insert(tblSQL, table.remove(tblSetLiving)) -- transfer one value to SQL table
if #tblSetLiving == 0 or #tblSQL > 999 then -- update this block of values
local SQL = 'UPDATE PersonTable SET Living = 1, UTCModDate = ' .. gblOptions.Now ..
' WHERE PersonID IN (' .. table.concat(tblSQL, ',') .. ')'
database:execute(SQL)
tblSQL = {}
end
end
while #tblClearLiving > 0 do
table.insert(tblSQL, table.remove(tblClearLiving)) -- transfer one value to SQL table
if #tblClearLiving == 0 or #tblSQL > 999 then -- update this block of values
local SQL = 'UPDATE PersonTable SET Living = 0, UTCModDate = ' .. gblOptions.Now ..
' WHERE PersonID IN (' .. table.concat(tblSQL, ',') .. ')'
database:execute(SQL)
tblSQL = {}
end
end
end
tblFH = nil
tblRM = nil
ResultSet = nil
collectgarbage('collect')
return alert
end
-- *********************************************************************
function CheckSpouses(database, tblUID, tblUpdates)
local tblT = {}
local count = 0
-- get FH spouses
ProgressBarIncrement('Getting FH Spouses')
local pF = fhNewItemPtr()
pF:MoveToFirstRecord('FAM')
while pF:IsNotNull() do
local pH, pW = GetFamilySpouses(pF)
if pH:IsNotNull() and pW:IsNotNull() then -- both spouses known
if not IsExcluded(pH) and not IsExcluded(pW) then
local UIDh = FormatUID(fhGetItemText(pH, '~._UID'))
local UIDw = FormatUID(fhGetItemText(pW, '~._UID'))
if not tblT[UIDh] then
tblT[UIDh] = {}
tblT[UIDh].FH = {}
end
table.insert(tblT[UIDh].FH, UIDw)
if not tblT[UIDw] then
tblT[UIDw] = {}
tblT[UIDw].FH = {}
end
table.insert(tblT[UIDw].FH, UIDh)
end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
pF:MoveNext()
end
-- get RM spouses
ProgressBarIncrement('Getting RM Spouses')
count = 0
local SQL = 'SELECT P1.UniqueID UIDh, P2.UniqueID UIDw FROM FamilyTable F ' ..
'LEFT JOIN PersonTable P1 ON F.FatherID = P1.PersonID ' ..
'LEFT JOIN PersonTable P2 ON F.MotherID = P2.PersonID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local UIDh = p.UIDh
local UIDw = p.UIDw
if UIDh and UIDw then
if not tblT[UIDh] then tblT[UIDh] = {} end
if not tblT[UIDh].RM then tblT[UIDh].RM = {} end
table.insert(tblT[UIDh].RM, UIDw)
if not tblT[UIDw] then tblT[UIDw] = {} end
if not tblT[UIDw].RM then tblT[UIDw].RM = {} end
table.insert(tblT[UIDw].RM, UIDh)
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- sort spouses for comparison
ProgressBarIncrement('Comparing Spouses')
count = 0
for UID, Spouses in pairs(tblT) do
if Spouses.FH then
table.sort(Spouses.FH)
Spouses.FH = table.concat(Spouses.FH)
end
if Spouses.RM then
table.sort(Spouses.RM)
Spouses.RM = table.concat(Spouses.RM)
end
end
-- compare spouses
for UID, Spouses in pairs(tblT) do
if not Spouses.FH or not Spouses.RM or Spouses.FH ~= Spouses.RM then
if tblUID[UID].IDfh and tblUID[UID].IDrm then -- do not include missing individuals
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], 'Spouse')
end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
tblT = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckParents(database, tblUID, tblFHI, tblFHF, tblUpdates)
local p = fhNewItemPtr()
local tblT = {}
local count = 0
local null_count = 0
local function GetParentString(tblP)
local tblT = {}
if tblP.F then
table.insert(tblT, (tblP.F.UID or ''))
table.insert(tblT, (tblP.F.Relationship or ''))
end
if tblP.M then
table.insert(tblT, (tblP.M.UID or ''))
table.insert(tblT, (tblP.M.Relationship or ''))
end
return table.concat(tblT)
end
-- get FH parents
ProgressBarIncrement('Getting FH Parents')
for _, I in pairs(tblFHI) do
local UID = FormatUID(fhGetItemText(I.p, '~._UID'))
p:MoveTo(I.p, '~.FAMC')
while p:IsNotNull() do
local pF = fhGetValueAsLink(p)
local ID = fhGetRecordId(pF)
local pH, pW = GetFamilySpouses(pF)
local Frel, Mrel = GetParentRelationships(I.p, pF)
if tblFHF[ID] then -- exclude unlisted families
if not tblT[UID] then tblT[UID] = {FH = {}, RM = {}} end
local tblP = {} -- table for this family relationships
if pH:IsNotNull() and not IsExcluded(pH) then -- father listed
tblP.F = {}
tblP.F.UID = FormatUID(fhGetItemText(pH, '~._UID'))
tblP.F.Relationship = Frel
end
if pW:IsNotNull() and not IsExcluded(pW) then -- mother listed
tblP.M = {}
tblP.M.UID = FormatUID(fhGetItemText(pW, '~._UID'))
tblP.M.Relationship = Mrel
end
table.insert(tblT[UID].FH, tblP)
end
p:MoveNext('SAME_TAG')
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM parents
local tblR = {'birth', 'adopted', 'step', 'foster'}
ProgressBarIncrement('Getting RM Parents')
count = 0
local SQL = 'SELECT Pc.UniqueID UID, Pf.UniqueID UIDf, Pm.UniqueID UIDm, ' ..
'C.RelFather RelF, C.RelMother RelM FROM ChildTable C ' ..
'INNER JOIN FamilyTable F ON C.FamilyID = F.FamilyID ' ..
'LEFT JOIN PersonTable Pc ON C.ChildID = Pc.PersonID ' ..
'LEFT JOIN PersonTable Pf ON F.FatherID = Pf.PersonID ' ..
'LEFT JOIN PersonTable Pm ON F.MotherID = Pm.PersonID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local UID = p.UID
local UIDf = p.UIDf
local RelF = p.RelF
local UIDm = p.UIDm
local RelM = p.RelM
if UID then
if not tblT[UID] then tblT[UID] = {FH = {}, RM = {}} end
local tblP = {}
if UIDf then
tblP.F = {}
tblP.F.UID = UIDf
if RelF < 4 then tblP.F.Relationship = tblR[RelF+1] end
end
if UIDm then
tblP.M = {}
tblP.M.UID = UIDm
if RelM < 4 then tblP.M.Relationship = tblR[RelM+1] end
end
table.insert(tblT[UID].RM, tblP)
else
null_count = null_count + 1
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
if null_count > 0 then
local msg = 'Cannot get RootsMagic Parent identities. ' ..
'RM database file may be corrupted.'
MessageBox(msg, 'OK', 'ERROR')
ResultSet = nil
tblT = nil
collectgarbage('collect')
return -1
end
-- compare parents
ProgressBarIncrement('Comparing Parents')
count = 0
for UID, tblA in pairs(tblT) do
if tblUID[UID].IDfh and tblUID[UID].IDrm then -- ignore missing individuals
local match = false
for _, tblFHP in ipairs(tblA.FH) do
local FHstring = GetParentString(tblFHP)
for _, tblRMP in ipairs(tblA.RM) do
local RMstring = GetParentString(tblRMP)
if FHstring == RMstring then -- matching parents found
match = true
break
end
end
end
for _, tblRMP in ipairs(tblA.RM) do
local RMstring = GetParentString(tblRMP)
for _, tblFHP in ipairs(tblA.FH) do
local FHstring = GetParentString(tblFHP)
if FHstring == RMstring then -- matching parents found
match = true
break
end
end
end
if not match then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], 'Parents')
end
end
count = count + 1
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
tblT = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckNames(database, tblFHI, tblUpdates, Update)
local tblFH = {}
local tblRM = {}
local count = 0
-- get FH Individual names (turn off preference setting temporarily to ensure case-sensitive)
ProgressBarIncrement('Getting FH Names')
fhOverridePreference('SURNAMES_UPPERCASE', true, false)
for _, I in pairs(tblFHI) do
local pN = fhNewItemPtr()
local tblNames = {}
pN:MoveTo(I.p, '~.NAME')
if pN:IsNull() then -- use dummy name to match RM name
local tblN = {Given = '?', Surname = '', Prefix = '', Suffix = '', Nickname = ''}
table.insert(tblNames, tblN)
end
while pN:IsNotNull() do
local tblN = {}
tblN.Given = fhGetItemText(pN, '~.GIVN')
tblN.GivenAll = fhGetItemText(pN, '~:GIVEN_ALL')
tblN.Surname = fhGetItemText(pN, '~:SURNAME')
tblN.Prefix = fhGetItemText(pN, '~.NPFX')
tblN.Suffix = fhGetItemText(pN, '~.NSFX')
tblN.Nickname = fhGetItemText(pN, '~.NICK')
table.insert(tblNames, tblN)
pN:MoveNext('SAME_TAG') -- alternative names
end
tblFH[I.UID] = tblNames
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
fhOverridePreference('SURNAMES_UPPERCASE', false)
-- get all RM Individual names
ProgressBarIncrement('Getting RM Names')
count = 0
local SQL = 'SELECT UniqueID, NameID, Surname, Given, Prefix, Suffix, Nickname, IsPrimary ' ..
'FROM PersonTable, NameTable WHERE PersonID = OwnerID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local tblN = {}
local UID = p.UniqueID
tblN.NameID = tonumber(p.NameID)|0
tblN.Prefix = p.Prefix
tblN.Suffix = p.Suffix
tblN.Nickname = p.Nickname
tblN.Given = p.Given
tblN.Surname = p.Surname
if not tblRM[UID] then tblRM[UID] = {} end
if p.IsPrimary == 1 then
table.insert(tblRM[UID], 1, tblN) -- top of table
else
table.insert(tblRM[UID], tblN) -- end of table
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ProgressBarIncrement('Comparing Names')
-- clear Prefix and Nickname if auditing
if IsAuditTree() then
for UID, Names in pairs(tblFH) do
for _, Name in ipairs(Names) do
Name.Prefix = nil
Name.Nickname = nil
end
end
for UID, Names in pairs(tblRM) do
for _, Name in ipairs(Names) do
Name.Prefix = nil
Name.Nickname = nil
end
end
end
-- compare names
count = 0
for UID, Names in pairs(tblFH) do
if tblRM[UID] then
local matchPrimary, matchAlternative
if #Names == 1 and #tblRM[UID] == 1 then
matchAlternative = true -- no alternative names
end
for iFH = 1, #Names do
for iRM = 1, #tblRM[UID] do
if Names[iFH].Prefix == tblRM[UID][iRM].Prefix and
Names[iFH].Suffix == tblRM[UID][iRM].Suffix and
(Names[iFH].Given == tblRM[UID][iRM].Given or
Names[iFH].GivenAll == tblRM[UID][iRM].Given) and
Names[iFH].Surname == tblRM[UID][iRM].Surname and
Names[iFH].Nickname == tblRM[UID][iRM].Nickname then
if iFH == 1 and iRM == 1 then
matchPrimary = true
elseif iFH > 1 and iRM > 1 then
matchAlternative = true
end
if Update and iFH == 1 and iRM > 1 then -- update primary name in RM
for _, N in ipairs(tblRM[UID]) do
SQL = 'UPDATE NameTable SET IsPrimary = 0, UTCModDate = ' ..
gblOptions.Now .. ' WHERE NameID = ' .. N.NameID
database:execute(SQL)
end
SQL = 'UPDATE NameTable SET IsPrimary = 1, UTCModDate = ' ..
gblOptions.Now .. ' WHERE NameID = ' .. tblRM[UID][iRM].NameID
database:execute(SQL)
end
end
end
end
if (not matchPrimary or not matchAlternative) and not Update then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
if not matchPrimary then table.insert(tblUpdates[UID], 'Primary Name') end
if not matchAlternative then table.insert(tblUpdates[UID], 'Alternative Name') end
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
tblFH = nil
tblRM = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckSex(database, tblUID, tblFHI, tblUpdates, Update)
local tblFH = {}
local tblRM = {}
local alert
local count = 0
-- get FH Individual details
ProgressBarIncrement('Getting FH Sex')
for _, I in pairs(tblFHI) do
local Sex = fhGetItemText(I.p, '~.SEX')
if Sex == '' then Sex = 'Unknown' end
tblFH[I.UID] = Sex
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM Individual details
ProgressBarIncrement('Getting RM Sex')
count = 0
local tblSex = {'Male', 'Female', 'Unknown'}
local SQL = 'SELECT UniqueID, Sex FROM PersonTable'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
tblRM[p.UniqueID] = tblSex[p.Sex + 1]
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- compare tables
ProgressBarIncrement('Comparing Sex')
count = 0
for _, I in pairs(tblFHI) do
local UID = I.UID
if tblFH[UID] and tblRM[UID] and tblFH[UID] ~= tblRM[UID] then
if Update then
local NewSex = 0
if tblFH[UID] == 'Female' then NewSex = 1
elseif tblFH[UID] == 'Unknown' then NewSex = 2 end
SQL = 'UPDATE PersonTable SET Sex = ' .. NewSex .. ', UTCModDate = ' .. gblOptions.Now ..
' WHERE PersonID = ' .. tblUID[UID].IDrm
database:execute(SQL)
if gblOptions.TreeID then
SQL = 'UPDATE AncestryTable SET Modified = 1, UTCModDate = ' .. gblOptions.Now ..
' WHERE rmID = ' .. tblUID[UID].IDrm
database:execute(SQL)
end
else
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], 'Sex')
alert = true
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
ResultSet = nil
tblFH = nil
tblRM = nil
collectgarbage('collect')
return alert
end
-- *********************************************************************
function CheckIndividualFact(database, tblUID, tblUpdates, Fact, Update)
local tblFH = {}
local tblRM = {}
local count = 0
-- do not compare if Census, as these included in Residence, and no values in RM
if Fact.Tag == 'CENS' then return end
-- get FH Individual details
ProgressBarIncrement('Getting FH ' .. Fact.Description)
for UID, I in pairs(tblUID) do
if I.IDfh then
local p = fhNewItemPtr()
if Fact.Tag == 'RESI' then -- also include Census entries
p:MoveTo(I.p, '~.CENS')
while p:IsNotNull() do
local Value = fhGetValueAsText(p) -- attributes only
local Date = fhGetItemText(p, '~.DATE')
local Place = fhGetItemText(p, '~.PLAC')
local Event = Value .. Date .. Place:gsub(' ', '')
if Event ~= '' and fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if not tblFH[UID] then tblFH[UID] = {} end
tblFH[UID][Event] = true
end
p:MoveNext('SAME_TAG')
end
end
p:MoveTo(I.p, '~.' .. Fact.Tag)
while p:IsNotNull() do
local Value = fhGetValueAsText(p) -- attributes only
local Date = fhGetItemText(p, '~.DATE')
local Place = fhGetItemText(p, '~.PLAC')
local Event = Value .. Date .. Place:gsub(' ', '')
if Event ~= '' and fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if not tblFH[UID] then tblFH[UID] = {} end
tblFH[UID][Event] = true
end
p:MoveNext('SAME_TAG')
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM Individual details
ProgressBarIncrement('Getting RM ' .. Fact.Description)
count = 0
local SQL = 'SELECT I.UniqueID UniqueID, E.EventID EventID, E.Date Date, P.Name Place, ' ..
'E.Details Details FROM EventTable E ' ..
'JOIN FactTypeTable F ON E.EventType = F.FactTypeID AND ' ..
'F.Abbrev = "' .. Fact.Description .. '" ' ..
'JOIN PersonTable I ON E.OwnerID = I.PersonID ' ..
'LEFT JOIN PlaceTable P ON E.PlaceID = P.PlaceID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local UID = p.UniqueID
local Details = p.Details
local Date = FormatRMDate(p.Date)
local Place = p.Place
local Event = (Details or '') .. (Date or '') .. (Place or ''):gsub(' ', '')
if not tblRM[UID] then tblRM[UID] = {} end
if Event ~= '' then tblRM[UID][Event] = tonumber(p.EventID)|0 end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count, 'Facts') end
end
-- find FH facts that are not in RM and add to list for prompted sync
ProgressBarIncrement('Comparing ' .. Fact.Description)
for UID, Events in pairs(tblFH) do
for Event, _ in pairs(Events) do
if tblUID[UID].IDfh and tblUID[UID].IDrm and not MatchEvent(UID, Event, tblRM) then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], Fact.Description)
end
end
end
-- find RM facts that are not in FH, and delete
local tblX = {} -- Events to be deleted
for UID, Events in pairs(tblRM) do
for Event, EventID in pairs(Events) do
if tblUID[UID].IDfh and tblUID[UID].IDrm and not MatchEvent(UID, Event, tblFH) then
if Update then
table.insert(tblX, EventID)
else
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], Fact.Description)
end
end
end
end
if #tblX > 0 and Update then
for _, Event in ipairs(tblX) do
SQL = 'DELETE FROM EventTable WHERE EventID = ' .. Event
database:execute(SQL)
end
end
ResultSet = nil
tblFH = nil
tblRM = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckFamilyFact(database, tblFHI, tblRMI, tblUID, tblFHF, tblUpdates, Fact, Update)
local tblFH = {}
local tblRM = {}
local count = 0
-- get FH Family details
ProgressBarIncrement('Getting FH ' .. Fact.Description)
for _, F in pairs(tblFHF) do
local UIDh, UIDw
if F.IDh then UIDh = tblFHI[F.IDh].UID end
if F.IDw then UIDw = tblFHI[F.IDw].UID end
local pF = F.p
local p = fhNewItemPtr()
p:MoveTo(pF, '~.' .. Fact.Tag)
while p:IsNotNull() do
local Value = fhGetValueAsText(p) -- attributes only
local Date = fhGetItemText(p, '~.DATE')
local Place = fhGetItemText(p, '~.PLAC')
local Event = Value .. Date .. Place:gsub(' ', '')
if Event ~= '' and UIDh and fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if not tblFH[UIDh] then tblFH[UIDh] = {} end
tblFH[UIDh][Event] = true
end
if Event ~= '' and UIDw and fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if not tblFH[UIDw] then tblFH[UIDw] = {} end
tblFH[UIDw][Event] = true
end
p:MoveNext('SAME_TAG')
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- get RM Family details
ProgressBarIncrement('Getting RM ' .. Fact.Description)
count = 0
local SQL = 'SELECT Fam.FatherID FatherID, Fam.MotherID MotherID, E.EventID EventID, E.Date Date, ' ..
'P.Name Place, E.Details Details FROM EventTable E ' ..
'JOIN FactTypeTable F ON E.EventType = F.FactTypeID ' ..
'JOIN FamilyTable Fam ON E.OwnerID = Fam.FamilyID and F.Abbrev = "' ..
Fact.Description .. '" ' ..
'LEFT JOIN PlaceTable P ON E.PlaceID = P.PlaceID'
local ResultSet = database:select(SQL)
for f in ResultSet:rows() do
local UIDf, UIDm
local FatherID = tonumber(f.FatherID)|0
local MotherID = tonumber(f.MotherID)|0
local EventID = tonumber(f.EventID)|0
if FatherID > 0 and tblRMI[FatherID] then UIDf = tblRMI[FatherID].UID end
if MotherID > 0 and tblRMI[MotherID] then UIDm = tblRMI[MotherID].UID end
local Details = f.Details
local Date = FormatRMDate(f.Date)
local Place = f.Place
local Event = (Details or '') .. (Date or '') .. (Place or ''):gsub(' ', '')
if Event ~= '' and UIDf then -- assign fact to father
if not tblRM[UIDf] then tblRM[UIDf] = {} end
tblRM[UIDf][Event] = EventID
end
if Event ~= '' and UIDm then -- assign fact to mother
if not tblRM[UIDm] then tblRM[UIDm] = {} end
tblRM[UIDm][Event] = EventID
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count) end
end
-- find FH facts that are not in RM and add to list for prompted sync
ProgressBarIncrement('Comparing ' .. Fact.Description)
for UID, Events in pairs(tblFH) do
for Event, _ in pairs(Events) do
if tblUID[UID].IDfh and tblUID[UID].IDrm and not MatchEvent(UID, Event, tblRM) then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], Fact.Description)
end
end
end
-- find RM facts that are not in FH, and delete
local tblX = {} -- Events to be deleted
for UID, Events in pairs(tblRM) do
for Event, EventID in pairs(Events) do
if tblUID[UID].IDfh and tblUID[UID].IDrm and not MatchEvent(UID, Event, tblFH) then
if Update then
table.insert(tblX, EventID)
else
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], Fact.Description)
end
end
end
end
if #tblX > 0 and Update then
for _, Event in ipairs(tblX) do
SQL = 'DELETE FROM EventTable WHERE EventID = ' .. Event
database:execute(SQL)
end
end
ResultSet = nil
tblFH = nil
tblRM = nil
collectgarbage('collect')
end
-- *********************************************************************
function CheckRedundantEvents(database, tblRMI, tblUID, tblUpdates, Update)
-- check for events in RM not included in standard set
ProgressBarIncrement('Checking Redundant Events')
local tblI, tblF = DefineFacts()
local tblT = {} -- Event types to be deleted
local tblX = {} -- Specific events to be deleted
local count = 0
-- get Individual Events
for _,Fact in ipairs(tblI) do table.insert(tblT, '"' .. Fact.Description .. '"') end
local EventList = table.concat(tblT, ',')
local SQL = 'SELECT I.UniqueID UniqueID, E.EventID EventID, F.Abbrev FROM EventTable E ' ..
'JOIN FactTypeTable F ON E.EventType = F.FactTypeID AND ' ..
'F.Abbrev NOT IN (' .. EventList .. ') AND E.OwnerType = 0 ' ..
'JOIN PersonTable I ON E.OwnerID = I.PersonID'
local ResultSet = database:select(SQL)
for p in ResultSet:rows() do
local UID = p.UniqueID
local EventID = tonumber(p.EventID)|0
if Update then
table.insert(tblX, EventID)
else
if tblUID[UID].IDfh then
if not tblUpdates[UID] then tblUpdates[UID] = {} end
table.insert(tblUpdates[UID], p.Abbrev)
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count, 'Facts') end
end
-- get Family Events
tblT = {}
for _, Fact in ipairs(tblF) do table.insert(tblT, '"' .. Fact.Description .. '"') end
EventList = table.concat(tblT, ',')
SQL = 'SELECT Fam.FamilyID FamilyID, Fam.FatherID FatherID, Fam.MotherID MotherID, ' ..
'E.EventID EventID, F.Abbrev FROM EventTable E ' ..
'JOIN FactTypeTable F ON E.EventType = F.FactTypeID AND F.Abbrev NOT IN (' ..
EventList .. ') AND E.OwnerType = 1 ' ..
'JOIN FamilyTable Fam ON E.OwnerID = Fam.FamilyID'
local ResultSet = database:select(SQL)
for f in ResultSet:rows() do
local EventID = tonumber(f.EventID)|0
local FatherID = tonumber(f.FatherID)|0
local MotherID = tonumber(f.MotherID)|0
if Update then
table.insert(tblX, EventID)
else
if FatherID > 0 then -- father event list
local UIDf = tblRMI[FatherID].UID
if tblUID[UIDf].IDfh then
if not tblUpdates[UIDf] then tblUpdates[UIDf] = {} end
table.insert(tblUpdates[UIDf], f.Abbrev)
end
end
if MotherID > 0 then -- mother event list
local UIDm = tblRMI[MotherID].UID
if tblUID[UIDm].IDfh then
if not tblUpdates[UIDm] then tblUpdates[UIDm] = {} end
table.insert(tblUpdates[UIDm], f.Abbrev)
end
end
end
count = count + 1
if count % 5000 == 0 then fhExhibitResponsiveness() end
if count % 1000 == 0 then ProgressBarUpdate(count, 'Facts') end
end
-- delete redundant events if updating
local tblSQL = {}
while #tblX > 0 and Update do
table.insert(tblSQL, table.remove(tblX)) -- transfer one value to SQL table
if #tblX == 0 or #tblSQL > 999 then -- update this block of values
database:execute('DELETE FROM EventTable WHERE EventID IN (' .. table.concat(tblSQL, ',') .. ')')
tblSQL = {}
end
end
end
-- *********************************************************************
function UpdateRMTimeStamps(database, FileName)
-- reads list of changed individuals and updates RM timestamps accordingly
ProgressBarIncrement('Updating RM Timestamps')
local count = 0
local DataFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync List.txt'
if not fhfu.fileExists(DataFile) then return end
local S = fhLoadTextFile(DataFile)
local tblS = {}
for IDrm in S:gmatch('[^\r\n]+') do
table.insert(tblS, IDrm)
end
local tblSQL = {}
while #tblS > 0 do
table.insert(tblSQL, table.remove(tblS)) -- transfer one value to SQL table
if #tblS == 0 or #tblSQL > 999 then -- update this block of values
local SQL = 'UPDATE PersonTable SET UTCModDate = ' .. gblOptions.Now .. ' WHERE PersonID IN (' ..
table.concat(tblSQL, ',') .. ')'
database:execute(SQL)
tblSQL = {}
end
end
end
-- *********************************************************************
function UpdateAncestryList(database, FileName, tblUID)
-- reads list of changed individuals and updates Ancestry Table accordingly
ProgressBarIncrement('Updating Ancestry changed list')
local DataFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync List.txt'
local count = 0
if not fhfu.fileExists(DataFile) then return end
local S = fhLoadTextFile(DataFile)
local tblS = {}
for IDrm in S:gmatch('[^\r\n]+') do
table.insert(tblS, IDrm)
end
local SQL
local tblSQL = {}
while #tblS > 0 do
table.insert(tblSQL, table.remove(tblS)) -- transfer one value to SQL table
if #tblS == 0 or #tblSQL > 999 then -- update this block of values
local SQL = 'UPDATE AncestryTable SET Modified = 1, UTCModDate = ' .. gblOptions.Now ..
' WHERE rmID IN (' ..
table.concat(tblSQL, ',') .. ')'
database:execute(SQL)
tblSQL = {}
end
end
end
-- *********************************************************************
function MatchEvent(UID, Event, tblEvents)
-- finds Event in tblEvents, matched on UID (case insensitive)
if not tblEvents[UID] then return false end
for E, _ in pairs(tblEvents[UID]) do
if gblOptions.Case then
if E == Event then return true end
else
if E:lower() == Event:lower() then return true end
end
end
end
-- *********************************************************************
-- Compare and Update functions (reporting)
-- *********************************************************************
function CheckIndividuals(tblUID)
local tblAdd = {}
local tblDelete = {}
-- identify missing individuals
for UID, I in pairs(tblUID) do
if not I.IDrm then table.insert(tblAdd, I.p) end
if not I.IDfh then table.insert(tblDelete, I) end
end
-- sort into alphabetical order
tblAdd = SortIndividuals(tblAdd) -- sort table into name order
tblDelete = SortRMIndividuals(tblDelete)
return tblAdd, tblDelete
end
-- *********************************************************************
function SortIndividuals(tblI)
-- Sorts an indexed table of Individual pointers into name order
local tblT = {}
for _, p in ipairs(tblI) do
local id = fhGetItemText(p, '~.NAME:SURNAME') .. ':' .. fhGetItemText(p, '~.NAME:GIVEN_ALL') ..
':' .. fhGetRecordId(p)
table.insert(tblT, id)
end
table.sort(tblT)
local tblSorted = {}
for _, id in ipairs(tblT) do
local RIN = tonumber(id:match('%d+$'))
local pI = fhNewItemPtr()
pI:MoveToRecordById('INDI', RIN)
table.insert(tblSorted, pI:Clone())
end
tblT = nil
return tblSorted
end
-- *********************************************************************
function SortRMIndividuals(tblI)
-- Sorts an indexed table of Individual pointers into name order
local tblT = {}
for _, I in ipairs(tblI) do
local id = I.Surname
if id == '' then id = ' ' end
id = id .. ':' .. I.Given .. ':' .. I.IDrm
table.insert(tblT, id)
end
table.sort(tblT)
local tblSorted = {}
for _, id in ipairs(tblT) do
local IDrm = tonumber(id:match('%d+$'))
for _, I in ipairs(tblI) do
if IDrm == I.IDrm then
table.insert(tblSorted, I)
break
end
end
end
tblT = nil
return tblSorted
end
-- *********************************************************************
function SortChangedIndividuals(tblUID, tblUpdates)
-- Sorts table of Individuals with changes via an intemediate table
local tblT = {}
for UID, _ in pairs(tblUpdates) do
local pI = tblUID[UID].p
local SortKey = fhGetItemText(pI, '~.NAME:SURNAME') .. ',' .. fhGetItemText(pI, '~.NAME:GIVEN_ALL') ..
',' .. fhGetItemText(pI, '~.BIRT.DATE:YEAR') .. ',' ..
fhGetItemText(pI, '~.BIRT.DEAT:YEAR') .. ',' .. UID
table.insert(tblT, SortKey)
end
table.sort(tblT)
-- Match sort keys and add to final sorted table
local tblSorted = {}
for _, SortedKey in ipairs(tblT) do
local UID = SortedKey:match('%x+$')
local tblC = {}
tblC.UID = UID
table.sort(tblUpdates[UID])
tblC.Facts = tblUpdates[UID]
table.insert(tblSorted, tblC)
end
tblT = nil
return tblSorted
end
-- *********************************************************************
function SortFamilies(tblF)
-- returns ordered table of omitted families
local p = fhNewItemPtr()
local tblT = {}
local tblSorted = {}
for RIN, _ in pairs(tblF) do
p:MoveToRecordById('FAM', RIN)
local p1, p2 = GetFamilySpouses(p)
local tblF = {}
if p1:IsNotNull() then
table.insert(tblF, fhGetItemText(p1, '~.NAME:SURNAME'))
table.insert(tblF, fhGetItemText(p1, '~.NAME:GIVEN_ALL'))
end
if p2:IsNotNull() then
table.insert(tblF, fhGetItemText(p2, '~.NAME:SURNAME'))
table.insert(tblF, fhGetItemText(p2, '~.NAME:GIVEN_ALL'))
end
table.insert(tblF, fhGetRecordId(p))
table.insert(tblT, table.concat(tblF, ':'))
end
table.sort(tblT)
for _, id in ipairs(tblT) do
local RIN = tonumber(id:match('%d+$'))
local pF = fhNewItemPtr()
pF:MoveToRecordById('FAM', RIN)
table.insert(tblSorted, pF:Clone())
end
tblT = nil
return tblSorted
end
-- *********************************************************************
function AddFHRecord(p, rt)
-- record FH Record as either link or plain text
if gblOptions.Links then
rt:AddRecordLink(p)
else
rt:AddText(fhGetItemText(p, '~.NAME'))
end
end
-- *********************************************************************
function CreateRecordList(tblUID)
-- generate optional cross-reference table
local tblFH = {}
local tblRM = {}
local tblRMS = {}
local tblFHID = {}
local tblRMID = {}
if gblOptions.Table and gblOptions.TableExists then -- table generated already
local msg = 'Cross-reference table has been generated already and will not be duplicated.'
MessageBox(msg, 'OK', 'WARNING')
return
end
for UID, I in pairs(tblUID) do
table.insert(tblFH, I.p or '')
if not I.Given and not I.Surname then
table.insert(tblRM, '')
elseif I.Given == '' or I.Surname == '' then
table.insert(tblRM, I.Given .. I.Surname:upper())
else
table.insert(tblRM, I.Given .. ' ' .. I.Surname:upper())
end
table.insert(tblRMS, (I.Surname or '') .. ', ' .. (I.Given or ''))
table.insert(tblFHID, I.IDfh or '')
table.insert(tblRMID, I.IDrm or '')
end
fhOutputResultSetTitles('Match List')
fhOutputResultSetColumn('Record', 'item', tblFH, #tblFH, 140)
fhOutputResultSetColumn('FH ID', 'integer', tblFHID, #tblFHID, 40)
fhOutputResultSetColumn('RM ID', 'integer', tblRMID, #tblRMID, 40)
fhOutputResultSetColumn('RM Name', 'text', tblRM, #tblRM, 140)
fhOutputResultSetColumn('', 'text', tblRMS, #tblRMS, 140, 'align_left', 1, true, 'default', 'hide')
gblOptions.TableExists = true -- prevents generating a second table
end
-- *********************************************************************
-- GEDCOM export functions
-- *********************************************************************
function ExportGEDCOM()
local pI = fhNewItemPtr()
local pF = fhNewItemPtr()
local tblI = {} -- excluded individuals
local tblF = {} -- excluded families
local TotalI, TotalF, ExcludedI, ExcludedF = 0, 0, 0, 0
local count = 0
local tblOutput = {}
local tblFactsI, tblFactsF = DefineFacts()
-- warning message about incompatible export
if gblOptions.DisableCompat then
local msg = 'You have selected to disable RootsMagic/Ancestry compatibility for the GEDCOM ' ..
'export. While this improves compatibility with other applications, the output file ' ..
'should NOT be used to update a RootsMagic database.\n\n' ..
'Are you sure that you want to continue with the export?'
if MessageBox(msg, 'YESNO', 'WARNING', nil, '2') ~= 1 then return end
end
if gblOptions.Unchanged then
local msg = 'This partial GEDCOM export should be used only for updating the linked ' ..
'RootsMagic database.'
if MessageBox(msg, 'OKCANCEL', 'WARNING', nil, '2') ~= 1 then return end
end
-- get export file name
local filedlg = iup.filedlg{dialogtype = 'SAVE', title = 'Export GEDCOM File',
extfilter = 'GEDCOM files (*.ged)|*.ged|All Files (*.*)|*.*|',
file = fhGetContextInfo('CI_PROJECT_NAME') .. '.ged',
directory = fhfu.splitPath(gblOptions.GFile or '').parent, extdefault = 'ged'}
if gblOptions.Unchanged then filedlg.Title = 'Export GEDCOM Update File' end
filedlg:popup()
if filedlg.Status == '-1' then return end
local FileName = filedlg.Value
-- save file as default next time
gblOptions.GFile = FileName
-- Identify excluded individuals and store in table.
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
if not gblOptions.Unchanged then
tblI[fhGetRecordId(pI)] = IsExcluded(pI)
else
if not gblOptions.Unchanged.I[fhGetRecordId(pI)] then
tblI[fhGetRecordId(pI)] = true
end
end
TotalI = TotalI + 1
pI:MoveNext()
end
for I, _ in pairs(tblI) do ExcludedI = ExcludedI + 1 end
-- Identify excluded families and store in table.
pF:MoveToFirstRecord('FAM')
while pF:IsNotNull() do
if not gblOptions.Unchanged then
tblF[fhGetRecordId(pF)] = IsExcluded(pF, true)
else
if not (gblOptions.Unchanged.F and gblOptions.Unchanged.F[fhGetRecordId(pF)]) then
tblF[fhGetRecordId(pF)] = true
end
end
TotalF = TotalF + 1
pF:MoveNext()
end
for F, _ in pairs(tblF) do ExcludedF = ExcludedF + 1 end
-- Start progress bar
ProgressBarStart(TotalI + TotalF - ExcludedI - ExcludedF)
gblProgBar.Dialog.Title = 'Exporting GEDCOM file...'
gblProgBar.Action = 'Exporting GEDCOM file'
-- Write GEDCOM header
table.insert(tblOutput, '0 HEAD')
table.insert(tblOutput, '1 SOUR Family Historian')
table.insert(tblOutput, '1 GEDC')
table.insert(tblOutput, '2 VERS 5.5')
table.insert(tblOutput, '2 FORM LINEAGE-LINKED')
table.insert(tblOutput, '1 CHAR UTF-8')
table.insert(tblOutput, '1 DEST GED55')
-- Loop through all individuals, processing all non-excluded entries (turn off name case preference)
fhOverridePreference('SURNAMES_UPPERCASE', true, false)
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
if not tblI[fhGetRecordId(pI)] then
local p = fhNewItemPtr()
local pL = fhNewItemPtr()
table.insert(tblOutput, '0 @I' .. fhGetRecordId(pI) .. '@ INDI')
p:MoveTo(pI,'~.NAME')
if p:IsNull() then
-- give dummy name, as RM does not process unnamed individuals correctly
table.insert(tblOutput, '1 NAME ?')
end
while p:IsNotNull() do
if gblOptions.DisableCompat then
table.insert(tblOutput, '1 NAME ' .. fhGetValueAsText(p))
else
local surname = '/' .. fhGetItemText(p, '~:SURNAME') .. '/'
local given = fhGetItemText(p, '~:GIVEN_ALL')
if surname ~= '' and given ~= '' then
table.insert(tblOutput, '1 NAME ' .. given .. ' ' .. surname)
else
table.insert(tblOutput, '1 NAME ' .. given .. surname)
end
end
for _, Qualifier in ipairs({'NPFX', 'NSFX', 'NICK'}) do
local Q = fhGetItemText(p, '~.' .. Qualifier)
if Q ~= '' then table.insert(tblOutput, '2 ' .. Qualifier .. ' ' .. Q) end
end
p:MoveNext('SAME_TAG')
end
p:MoveTo(pI,'~.SEX')
if p:IsNotNull() then table.insert(tblOutput, '1 SEX ' ..
fhGetItemText(pI, '~.SEX'):sub(1, 1)) end
for _, Fact in ipairs(tblFactsI) do
local Tag = Fact.Tag
local Description = Fact.Description
p:MoveTo(pI, '~.' .. Tag)
while p:IsNotNull() do
if fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if Tag:sub(1,6) == '_ATTR-' or Tag:sub(1,5) == 'EVEN-' then -- custom fact
table.insert(tblOutput, '1 EVEN ' .. fhGetValueAsText(p))
table.insert(tblOutput, '2 TYPE ' .. Description)
elseif Tag == 'CENS' and not gblOptions.DisableCompat then
table.insert(tblOutput, '1 RESI') -- Ancestry compatibility
else
table.insert(tblOutput, '1 ' .. Tag .. ' ' .. fhGetValueAsText(p))
end
local pD = fhGetItemPtr(p,'~.DATE')
if pD:IsNotNull() then
table.insert(tblOutput, '2 DATE ' .. GetGEDCOMDate(pD))
end
local EventPlace = fhGetItemText(p, '~.PLAC')
if EventPlace ~= '' then table.insert(tblOutput, '2 PLAC ' .. EventPlace) end
end
p:MoveNext('SAME_TAG')
end
if Tag == 'DEAT' and fhGetItemPtr(pI, '~.DEAT'):IsNull() and
fhGetItemPtr(pI, '~._FLGS.__LIVING'):IsNull() then
table.insert(tblOutput, '1 DEAT Y') -- RM uses this format to denote non-living
end
end
pL:MoveTo(pI,'~.FAMC')
while pL:IsNotNull() do
p = fhGetValueAsLink(pL)
if not tblF[fhGetRecordId(p)] then -- exclude private families
table.insert(tblOutput, '1 FAMC @F' .. fhGetRecordId(p) .. '@')
end
pL:MoveNext('SAME_TAG')
end
pL:MoveTo(pI,'~.FAMS')
while pL:IsNotNull() do
p = fhGetValueAsLink(pL)
if not tblF[fhGetRecordId(p)] then -- exclude private individuals
table.insert(tblOutput, '1 FAMS @F' .. fhGetRecordId(p) .. '@')
end
pL:MoveNext('SAME_TAG')
end
p:MoveTo(pI,'~._UID') -- only export first value for RM compatibility
table.insert(tblOutput, '1 _UID ' .. FormatUID(fhGetValueAsText(p)))
end
count = count + 1
if count % 100 == 0 then
ProgressBarUpdate(count)
gblProgBar.bar.value = count
end
pI:MoveNext()
end
fhOverridePreference('SURNAMES_UPPERCASE', false)
-- Process non-private families
pF:MoveToFirstRecord('FAM')
while pF:IsNotNull() do
if not tblF[fhGetRecordId(pF)] then
local p = fhNewItemPtr()
table.insert(tblOutput, '0 @F' .. fhGetRecordId(pF) .. '@ FAM')
for _, Fact in ipairs(tblFactsF) do
local Tag = Fact.Tag
local Description = Fact.Description
p:MoveTo(pF, '~.' .. Tag)
while p:IsNotNull() do
if fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' then
if Tag:sub(1,6) == '_ATTR-' or Tag:sub(1,5) == 'EVEN-' then -- custom fact
table.insert(tblOutput, '1 EVEN ' .. fhGetValueAsText(p))
table.insert(tblOutput, '2 TYPE ' .. Description)
elseif Tag == 'CENS' then
table.insert(tblOutput, '1 RESI') -- Ancestry compatibility
else
table.insert(tblOutput, '1 ' .. Tag .. ' ' .. fhGetValueAsText(p))
end
local pD = fhGetItemPtr(p,'~.DATE')
if pD:IsNotNull() then
table.insert(tblOutput, '2 DATE ' .. GetGEDCOMDate(pD))
end
local EventPlace = fhGetItemText(p, '~.PLAC')
if EventPlace ~= '' then table.insert(tblOutput, '2 PLAC ' .. EventPlace) end
end
p:MoveNext('SAME_TAG')
end
end
local pL1, pL2 = GetFamilySpouses(pF)
if pL1:IsNotNull() then
table.insert(tblOutput, '1 HUSB @I' .. fhGetRecordId(pL1) .. '@')
end
if pL2:IsNotNull() then
table.insert(tblOutput, '1 WIFE @I' .. fhGetRecordId(pL2) .. '@')
end
pL1:MoveTo(pF,'~.CHIL')
while pL1:IsNotNull() do
p = fhGetValueAsLink(pL1)
if not tblI[fhGetRecordId(p)] then -- exclude private individuals
table.insert(tblOutput, '1 CHIL @I' .. fhGetRecordId(p) .. '@')
local Frel, Mrel = GetParentRelationships(p, pF)
if Frel then table.insert(tblOutput, '2 _FREL ' .. Frel) end
if Mrel then table.insert(tblOutput, '2 _MREL ' .. Mrel) end
end
pL1:MoveNext('SAME_TAG')
end
end
count = count + 1
if count % 100 == 0 then
ProgressBarUpdate(count)
gblProgBar.bar.value = count
end
pF:MoveNext()
end
table.insert(tblOutput, '0 TRLR')
-- generate export note
if gblOptions.GEDCOM then
GEDCOMreport(tblI, tblF, TotalI, TotalF, ExcludedI, ExcludedF)
end
gblProgBar.Dialog:destroy()
gblProgBar.Dialog = nil
-- check export is not empty (e.g. by selecting an empty Ancestry Sync list)
if TotalI == ExcludedI and TotalF == ExcludedF then
local msg = 'GEDCOM export file is empty, and will not be saved.'
MessageBox(msg, 'OK', 'ERROR')
return
end
fhSaveTextFile(FileName, table.concat(tblOutput, '\n') .. '\n')
tblOutput = nil
collectgarbage('collect')
-- provide confirmation message
local msg
if gblOptions.Unchanged then
msg = 'File update completed.\n\n' .. TotalI - ExcludedI .. ' individuals and ' ..
TotalF - ExcludedF .. ' families written to file.'
else
msg = 'File export completed.\n\n' .. TotalI - ExcludedI .. ' individuals and ' ..
TotalF - ExcludedF .. ' families written to file.'
end
if TotalI - ExcludedI == 1 then msg = msg:gsub('individuals', 'individual') end
if TotalF - ExcludedF == 1 then msg = msg:gsub('families', 'family') end
if ExcludedI + ExcludedF > 0 then
msg = msg .. '\n\nExcluded individuals: ' .. ExcludedI
msg = msg .. '\nExcluded families: ' .. ExcludedF
end
MessageBox(msg, 'OK', 'INFORMATION')
end
-- *********************************************************************
function GetParentRelationships(pI, pF)
local found
local F, M = 'birth', 'birth'
local pL = fhGetItemPtr(pI, '~.FAMC')
while pL:IsNotNull() do
if fhGetValueAsLink(pL):IsSame(pF) then
found = true
break
end
pL:MoveNext('SAME_TAG')
end
if not found then return end
local pP = fhGetItemPtr(pL, '~.PEDI')
while pP:IsNotNull() do
local aa = fhGetValueAsText(pP)
if aa == 'Adopted' or aa == 'Adopted (father)' then F = 'adopted' end
if aa == 'Foster' or aa == 'Foster (father)' then F = 'foster' end
if aa == 'Step' or aa == 'Step (father)' then F = 'step' end
if aa == 'Adopted' or aa == 'Adopted (mother)' then M = 'adopted' end
if aa == 'Foster' or aa == 'Foster (mother)' then M = 'foster' end
if aa == 'Step' or aa == 'Step (mother)' then M = 'step' end
pP:MoveNext('SAME_TAG')
end
return F, M
end
-- *********************************************************************
function GetUpdateList()
-- get update file and compare with current file stamps
if gblOptions.Full then return end -- never use extract
local UpdateFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync Update.txt'
local S = fhLoadTextFile(UpdateFile)
if not S then return end
local FHold = tonumber(S:match('FH=(%d+)'))
local RMold = tonumber(S:match('RM=(%d+)'))
local RMnew = fhfu.getDateModified(gblOptions.File)
if RMold ~= RMnew or FHUpdated(FHold) then return end
-- extract is still valid, so proceed
local Individuals = S:match('I=(%C+)%c') or ''
local tblI = {}
for I in Individuals:gmatch('([^,]+)') do
tblI[tonumber(I)] = true
end
local Families = S:match('F=(%C+)%c') or ''
local tblF = {}
for F in Families:gmatch('([^,]+)') do
tblF[tonumber(F)] = true
end
return {I = tblI, F = tblF}
end
-- *********************************************************************
function SetUpdateList(tblUpdates, tblAdd, tblUID)
local tblI = {}
local tblF = {}
-- add new and updated individuals unconditionally
for UID, _ in pairs(tblUpdates) do
table.insert(tblI, tblUID[UID].IDfh)
end
for _, I in ipairs(tblAdd) do
table.insert(tblI, fhGetRecordId(I))
end
-- add their families unconditionally, including any spouses
for UID, _ in pairs(tblUpdates) do
local ID = tblUID[UID].IDfh
local pI = fhNewItemPtr()
local pF = fhNewItemPtr()
pI:MoveToRecordById('INDI', ID)
pF:MoveTo(pI, '~.FAMS')
while pF:IsNotNull() do
local pL = fhGetValueAsLink(pF)
table.insert(tblF, fhGetRecordId(pL))
local pS = fhNewItemPtr()
pS:MoveTo(pL, '~.~SPOU[1]>')
if fhGetRecordId(pS) ~= ID then
table.insert(tblI, fhGetRecordId(pS))
else
pS:MoveTo(pL, '~.~SPOU[2]>')
table.insert(tblI, fhGetRecordId(pS))
end
pF:MoveNext('SAME_TAG')
end
end
-- expand tables to include hooks to link with existing family in RM merge
for _, I in ipairs(tblAdd) do
local pFAMS = fhGetItemPtr(I, '~.FAMS')
while pFAMS:IsNotNull() do
local pF = fhGetValueAsLink(pFAMS)
if not IsExcluded(pF, true) then
table.insert(tblF, fhGetRecordId(pF))
end
local pH, pW = GetFamilySpouses(pF)
if pH:IsNotNull() and not pH:IsSame(I) and not IsExcluded(pH) then -- spouse in scope
table.insert(tblI, fhGetRecordId(pH))
elseif pW:IsNotNull() and not pW:IsSame(I) and not IsExcluded(pW) then -- spouse in scope
table.insert(tblI, fhGetRecordId(pW))
end
local pCHIL = fhGetItemPtr(pF, '~.CHIL')
while pCHIL:IsNotNull() do
local pC = fhGetValueAsLink(pCHIL)
if not IsExcluded(pC) then table.insert(tblI, fhGetRecordId(pC)) end
pCHIL:MoveNext('SAME_TAG')
end
pFAMS:MoveNext('SAME_TAG')
end
local pFAMC = fhGetItemPtr(I, '~.FAMC')
while pFAMC:IsNotNull() do
local pF = fhGetValueAsLink(pFAMC)
if not IsExcluded(pF, true) then
table.insert(tblF, fhGetRecordId(pF))
end
local pH, pW = GetFamilySpouses(pF)
if pH:IsNotNull() and not IsExcluded(pH) then table.insert(tblI, fhGetRecordId(pH)) end
if pW:IsNotNull() and not IsExcluded(pW) then table.insert(tblI, fhGetRecordId(pW)) end
pFAMC:MoveNext('SAME_TAG')
end
end
-- save timestamps and lists of records for extract
local UpdateFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync Update.txt'
local S = 'FH=' .. os.time() .. '\n' ..
'RM=' .. fhfu.getDateModified(gblOptions.File) .. '\n' ..
'I=' .. table.concat(tblI, ',') .. '\nF=' .. table.concat(tblF, ',') .. '\n'
fhSaveTextFile(UpdateFile, S)
end
-- *********************************************************************
function GEDCOMreport(tblI, tblF, TotalI, TotalF, PrivateI, PrivateF)
-- create Research Note to output result of GEDCOM export
local rt = fhNewRichText()
rt:AddText('Title:\tAncestry Sync – GEDCOM Export\n')
rt:AddText('Type:\tAncestry Sync\n')
rt:AddText('Date:\t' .. os.date('%d' .. ' ' .. '%b' .. ' ' .. '%Y') .. '\n')
rt:AddText('Status:\topen\n\n')
rt:AddText('')
rt:AddText('FH Project: | ' .. fhGetContextInfo('CI_PROJECT_NAME') .. ' (' ..
fhGetContextInfo('CI_PROJECT_FILE'):gsub('\\', '\\\\') .. '
')
rt:AddText('GEDCOM File: | ' .. gblOptions.GFile:gsub('\\', '\\\\') .. '
')
rt:AddText('\n\n')
rt:AddText('This Research Note summarises the result of the GEDCOM export from the ' ..
'Ancestry Synchronization plugin.\n\n')
rt:AddText('')
rt:AddText(' | Total | Exported | Excluded
')
rt:AddText('Individuals: | ' .. TotalI .. ' | ' .. TotalI - PrivateI .. '| ' .. PrivateI .. '
')
rt:AddText('Families: | ' .. TotalF .. ' | ' .. TotalF - PrivateF .. '| ' .. PrivateF .. '
')
rt:AddText('\n')
if PrivateI > 0 and not gblOptions.Unchanged then
rt:AddText('\nIndividuals excluded from export:\n\n')
-- copy omitted individuals to new table for easier sorting
local tblT = {}
for RIN, _ in pairs(tblI) do
local pI = fhNewItemPtr()
pI:MoveToRecordById('INDI', RIN)
table.insert(tblT, pI:Clone())
end
tblT = SortIndividuals(tblT)
for _, pI in ipairs(tblT) do
AddFHRecord(pI, rt)
rt:AddText(' (' .. IsExcluded(pI) .. ')\n')
end
end
if PrivateF > 0 and not gblOptions.Unchanged then
rt:AddText('\nFamilies excluded from export:\n\n')
tblF = SortFamilies(tblF)
for _, pF in ipairs(tblF) do
local p1, p2 = GetFamilySpouses(pF)
if p1:IsNotNull() then
AddFHRecord(p1, rt)
if IsExcluded(p1) then rt:AddText(' (' .. (IsExcluded(p1) or '') .. ')') end
else
rt:AddText('Unknown')
end
rt:AddText(' & ')
if p2:IsNotNull() then
AddFHRecord(p2, rt)
if IsExcluded(p2) then rt:AddText(' (' .. (IsExcluded(p2) or '') .. ')') end
else
rt:AddText('Unknown')
end
rt:AddText('\n')
end
end
if PrivateI + PrivateF == 0 then
rt:AddText('\nAll Individuals and Families exported to GEDCOM file.')
end
-- create Research Note from assembled content
local pRN = fhCreateItem('_RNOT')
local pT = fhGetItemPtr(pRN, '~.TEXT')
fhSetValueAsRichText(pT, rt)
fhUpdateDisplay()
end
-- *********************************************************************
-- Ancestry audit functions
-- *********************************************************************
function AuditAncestryGEDCOM()
-- lists defined errors in Ancestry GEDCOM export file
-- get Ancestry export file name
local filedlg = iup.filedlg{dialogtype = 'OPEN', title = 'Select Ancestry Export GEDCOM File',
directory = fhfu.splitPath(gblOptions.AFile or '').parent,
extfilter = 'GEDCOM files (*.ged)|*.ged|All Files (*.*)|*.*|'}
filedlg:popup()
if filedlg.Status == '-1' then return end
local FileName = filedlg.Value
gblOptions.AFile = FileName
local FileContents = fhLoadTextFile(FileName):gsub('\r\n', '\n') -- simple Unix endings
-- is this the correct file?
local _, RIN, _ = FileContents:match('(%c)3 RIN (%d+)(%c)')
if RIN ~= gblOptions.TreeID then
MessageBox('Incorrect GEDCOM file.', 'OK', 'ERROR')
return
end
-- correct known errors in file format
local NewFileContents = UpdateAncestryGEDCOM(FileContents)
-- modify Submitter record to confirm correct file when loading as new project
local S1 = '0 @SUBM1@ SUBM\n'
local S2 = '1 NAME Ancestry.com Member Trees Submitter\n'
local S3 = '1 NOTE FH Ancestry Sync Plugin\n'
if not NewFileContents:match(S1 .. S2 .. S3) then
NewFileContents = NewFileContents:gsub(S1 .. S2, S1 .. S2 .. S3, 1)
end
if NewFileContents ~= FileContents then
fhSaveTextFile(FileName, NewFileContents)
end
-- process data
local anID
local tblANCI = {} -- table for all Ancestry individuals
for Line in FileContents:gmatch('[^\r\n]+') do
if Line:match('^0') and anID then -- end of individual
anID = nil
end
if Line:match('^0 @I%d+@ INDI$') then -- start of new individual
anID = Line:match('^0 @I(%d+)@ INDI$')
tblANCI[anID] = {}
tblANCI[anID].Sex = {}
end
if Line:match('^1 SEX (%u)$') and anID then
table.insert(tblANCI[anID].Sex, Line:match('^1 SEX (%u)$'))
end
if Line:match('^1 MARR') and anID then
tblANCI[anID].MARR = true
end
if Line:match('^1 DIV') and anID then
tblANCI[anID].DIV = true
end
end
-- get table of Ancestry IDs and names
local tblANC = GetAncestryLinks()
-- rearrange to link Ancestry ID with name
local tblANCid = {}
for I, tblANid in pairs(tblANC) do
for _, anID in ipairs(tblANid) do
tblANCid[anID] = I
end
end
-- count how many records affected by extra SEX, MARR, or DIV tags
local CountS, CountM, CountD = 0, 0, 0
for anID, issue in pairs(tblANCI) do
if #issue.Sex > 1 then CountS = CountS + 1 end
if issue.MARR then CountM = CountM + 1 end
if issue.DIV then CountD = CountD + 1 end
end
-- identify individuals with multiple genders or family facts
local rt = fhNewRichText()
rt:AddText('Title:\tAncestry Audit - GEDCOM Export Issues\n')
rt:AddText('Type:\tAncestry Sync\n')
rt:AddText('Date:\t' .. os.date('%d' .. ' ' .. '%b' .. ' ' .. '%Y') .. '\n')
rt:AddText('Status:\topen\n\n')
rt:AddText('')
rt:AddText('FH Project: | ' .. fhGetContextInfo('CI_PROJECT_NAME') .. ' (' ..
fhGetContextInfo('CI_PROJECT_FILE'):gsub('\\', '\\\\') .. ')
')
rt:AddText('RM File: | ' .. gblOptions.File:gsub('\\', '\\\\') .. '
')
rt:AddText('Ancestry Tree: |
')
rt:AddText('GEDCOM File: | ' .. gblOptions.AFile:gsub('\\', '\\\\') .. '
')
rt:AddText('\n\n')
rt:AddText('This Research Note lists Individuals in the linked Ancestry tree where errors in the ' ..
'GEDCOM file have been noted (usually created as an artefact of TreeShare). Click on ' ..
'the links to edit the individual directly within Ancestry.\n')
if CountS > 0 then
rt:AddText('\nMultiple Gender Facts - correct in Ancestry, then repeat the GEDCOM export\n\n')
for anID, issues in pairs(tblANCI) do
if #issues.Sex > 1 then
rt:AddText('\n')
end
end
end
if CountM > 0 then
rt:AddText("\nMarriage Tag associated with Individual - review Individual's marriages in " ..
'Ancestry, then repeat the GEDCOM export if changes made\n\n')
for anID, issues in pairs(tblANCI) do
if issues.MARR then
rt:AddText('\n')
end
end
end
if CountD > 0 then
rt:AddText("\nDivorce Tag associated with Individual - review Individual's divorce in " ..
'Ancestry, then repeat the GEDCOM export if changes made\n\n')
for anID, issues in pairs(tblANCI) do
if issues.DIV then
rt:AddText('\n')
end
end
end
if CountS + CountM + CountD == 0 then
rt:AddText('\nNo GEDCOM issues detected in linked Ancestry Tree.')
end
local pRN = fhCreateItem('_RNOT')
local pT = fhGetItemPtr(pRN, '~.TEXT')
fhSetValueAsRichText(pT, rt)
fhUpdateDisplay()
local endmsg = 'Ancestry check completed and reported as new Research Note.'
if CountS + CountM + CountD == 0 then
endmsg = endmsg .. '\n\nNo multiple Gender Facts or extra Marriage or Divorce tags detected in ' ..
'linked Ancestry Tree.\n\nYou can now import the Ancestry GEDCOM file into Family ' ..
'Historian as a new Project to complete the audit.'
end
MessageBox(endmsg, 'OK', 'INFORMATION')
end
-- *********************************************************************
function AuditAncestryTree()
-- get data from linked RM file
local tblAncestry = GetAncestryLinks()
-- compile report
local rt = fhNewRichText()
rt:AddText('Title:\tAncestry Audit - Individuals\n')
rt:AddText('Type:\tAncestry Sync\n')
rt:AddText('Date:\t' .. os.date('%d' .. ' ' .. '%b' .. ' ' .. '%Y') .. '\n')
rt:AddText('Status:\topen\n\n')
rt:AddText('')
rt:AddText('FH Project: | ' .. fhGetContextInfo('CI_PROJECT_NAME') .. ' (' ..
fhGetContextInfo('CI_PROJECT_FILE'):gsub('\\', '\\\\') .. ')
')
rt:AddText('RM File: | ' .. gblOptions.File:gsub('\\', '\\\\') .. '
')
if gblOptions.TreeID then
rt:AddText('Ancestry Tree: |
')
end
rt:AddText('\n\n')
rt:AddText('This Research Note lists Individuals in the linked RootsMagic file that are either ' ..
'missing from the associated Ancestry tree or have been duplicated due to limitations in ' ..
'the TreeShare process.\n\n')
local Missing, Duplicate
for _, anc in pairs(tblAncestry) do
if #anc == 0 then Missing = true end
if #anc > 1 then Duplicate = true end
end
if Missing then
rt:AddText('Missing Individuals - re-run TreeShare to upload to Ancestry\n\n')
for rm, anc in pairs(tblAncestry) do
if #anc == 0 then rt:AddText(rm .. '\n') end
end
rt:AddText('\n')
end
if Duplicate then
rt:AddText('Duplicated Individuals - click on either hyperlink and merge the two ' ..
'records on Ancestry, then re-run TreeShare to update RootsMagic\n\n')
for rm, anc in pairs(tblAncestry) do
if #anc > 1 then
rt:AddText(rm)
for n, anID in ipairs(anc) do
rt:AddText(' - ')
end
rt:AddText('\n')
end
end
end
if not Missing and not Duplicate then
rt:AddText('No missing or duplicate individuals detected in linked Ancestry tree.')
end
local pRN = fhCreateItem('_RNOT')
local pT = fhGetItemPtr(pRN, '~.TEXT')
fhSetValueAsRichText(pT, rt)
fhUpdateDisplay()
local endmsg = 'Ancestry check completed and reported as new Research Note.'
if not Missing and not Duplicate then
endmsg = endmsg .. '\n\nNo missing or duplicate individuals detected in linked Ancestry tree.'
end
MessageBox(endmsg, 'OK', 'INFORMATION')
end
-- *********************************************************************
function GetAncestryLinks()
-- get table of names and Ancestry IDs from RM file
local database, SQLfile = OpenDatabase(gblOptions.File)
if not database then return end
local tblANC = {}
local SQL = 'SELECT UniqueID, Surname, Given, PersonID, anID ancID FROM PersonTable P ' ..
'JOIN NameTable N ON N.OwnerID = P.PersonID and N.IsPrimary = 1 ' ..
'LEFT JOIN AncestryTable A ON P.PersonID = A.rmID'
local ResultSet = database:select(SQL)
for I in ResultSet:rows() do
local PersonID = I.PersonID|0
local Record = I.Given .. ' ' .. I.Surname .. ' (RM' .. PersonID .. ')'
if not tblANC[Record] then tblANC[Record] = {} end
if I.ancID then
local ID = I.ancID:match('^%d+')
table.insert(tblANC[Record], ID)
end
end
database:close()
ResultSet = nil
collectgarbage('collect')
fhfu.deleteFile(SQLfile)
return tblANC
end
-- *********************************************************************
function IsAuditTree()
-- returns true if Submitter is Ancestry member tree
local p = fhNewItemPtr()
p:MoveToFirstRecord('SUBM')
local C1 = (fhGetItemText(p, '~.NAME') == 'Ancestry.com Member Trees Submitter')
local C2 = C1 and (fhGetItemText(p, '~.NOTE2') == 'FH Ancestry Sync Plugin')
return C1, C2
end
-- *********************************************************************
function UpdateAncestryGEDCOM(FileContents)
-- correct Custom ID (user-defined event in Ancestry)
FileContents = FileContents:gsub('1 EVEN\n2 TYPE Ref #\n2 NOTE', '1 REFN')
-- correct double dates
local tblS = {}
for Line in FileContents:gmatch('[^\r\n]+') do
if Line:match('%a%a%a%s%d%d%d%d%/%d$') then -- double dates
local y = tonumber(Line:sub(-4, -3))
if y == 99 then
Line = Line:sub(1, Line:len()-1) .. '00'
else
Line = Line:sub(1, Line:len()-1) .. (y+1)
end
end
if Line:match('^1 UID %w+$') then -- UniqueID
Line = '1 _UID ' .. Line:sub(7,14) .. '-' .. Line:sub(15,18) .. '-' ..
Line:sub(19,22) .. '-' .. Line:sub(23,26) .. '-' .. Line:sub(27)
end
table.insert(tblS, Line)
end
return table.concat(tblS, '\n') .. '\n'
end
-- *********************************************************************
-- General admin functions
-- *********************************************************************
function CountIndividuals()
local pI = fhNewItemPtr()
local n = 0
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
n = n + 1
pI:MoveNext()
end
return n
end
-- *********************************************************************
function CheckUIDs()
-- check that all Individuals have a UID assigned
local function GenerateUID()
local tblT = {}
for i = 1, 32 do
local num = math.random(0, 15)
table.insert(tblT, string.format('%X', num))
end
tblT[13] = '4' -- denotes version 4 (random numbers)
local var = math.random(8, 11) -- 8 to B
tblT[17] = string.format('%X', var)
table.insert(tblT, 21, '-')
table.insert(tblT, 17, '-')
table.insert(tblT, 13, '-')
table.insert(tblT, 9, '-')
return(table.concat(tblT))
end
-- prescreen prior to making any changes
local invalid, multiple, missing
local pI = fhNewItemPtr()
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
local pUID = fhGetItemPtr(pI, '~._UID')
if pUID:IsNull() then
missing = true
break
end
local UID = fhGetValueAsText(pUID)
local U1, U2, U3, U4, U5 = UID:match('^(%x+)%-(%x+)%-(%x+)%-(%x+)%-(%x+)$')
if not (U1 and U2 and U3 and U4 and U5) or U1:len() ~= 8 or U2:len() ~= 4 or
U3:len() ~= 4 or U4:len() ~= 4 or U5:len() ~= 12 then
invalid = true
break
end
pUID:MoveNext('SAME_TAG')
if pUID:IsNotNull() then multiple = true end
pI:MoveNext()
end
if invalid then
local msg = 'One or more Individuals has an invalid Unique ID. Please correct before proceeding'
MessageBox(msg, 'OK', 'ERROR')
return
end
if missing then
local msg = 'Do you want the plugin to generate and add missing Unique ID values to Individuals?'
if MessageBox(msg, 'OKCANCEL', 'QUESTION') ~= 1 then return end
end
-- generate any missing UID values
if missing then
pI:MoveToFirstRecord('INDI')
while pI:IsNotNull() do
local UID = fhGetItemText(pI, '~._UID')
if UID == '' then
local pUID = fhCreateItem('_UID', pI)
fhSetValueAsText(pUID, GenerateUID())
end
pI:MoveNext()
end
fhUpdateDisplay()
end
if multiple then
local msg = 'This project has one or more individuals with multiple UniqueID values. ' ..
'Only the first value is processed by this plugin, which may cause problems when ' ..
'comparing the project with the linked RootsMagic file.'
MessageBox(msg, 'OK', 'WARNING')
end
return true -- no missing UID values
end
-- *********************************************************************
function FormatRMDate(S)
-- converts RM proprietory date format to FH date
local Date = ''
local tblMonths = {'January', 'February', 'March', 'April', 'May', 'June', 'July',
'August', 'September', 'October', 'November', 'December'}
if S == '.' then return '' end -- null date
if S:sub(1,1) == 'T' then -- date phrase
S = '"' .. S:sub(2) .. '"' -- convert to FH format
return S
end
if S:sub(13,13) == 'C' or S:sub(13,13) == 'A' then Date = Date .. 'circa '
elseif S:sub(2,2) == 'A' then Date = Date .. 'after '
elseif S:sub(2,2) == 'B' then Date = Date .. 'before '
elseif S:sub(2,2) == 'F' then Date = Date .. 'from '
elseif S:sub(2,2) == 'S' then Date = Date .. 'from '
elseif S:sub(2,2) == 'R' then Date = Date .. 'between ' end
if S:sub(10,10) ~= '0' then Date = Date .. S:sub(10,10) end
if S:sub(10,11) ~= '00' then Date = Date .. S:sub(11,11) .. ' ' end
if S:sub(8,9) ~= '00' then Date = Date .. tblMonths[tonumber(S:sub(8,9))] .. ' ' end
if S:sub(4,7) ~= '0000' then Date = Date .. S:sub(4,7) end
if S:sub(12,12) == '/' then
Date = Date .. '/' .. tostring(tonumber(S:sub(4,7)) + 1):sub(3,4) end
if S:sub(2,2) == 'S' then Date = Date .. ' to '
elseif S:sub(2,2) == 'R' then Date = Date .. ' and ' end
if S:sub(21,21) ~= '0' then Date = Date .. S:sub(21,21) end
if S:sub(21,22) ~= '00' then Date = Date .. S:sub(22,22) .. ' ' end
if S:sub(19,20) ~= '00' then Date = Date .. tblMonths[tonumber(S:sub(19,20))] .. ' ' end
if S:sub(15,18) ~= '0000' then Date = Date .. S:sub(15,18) end
if S:sub(23,23) == '/' and S:sub(15,22) ~= '00000000' then -- slightly different format in RM7 & RM8
Date = Date .. '/' .. tostring(tonumber(S:sub(15,18)) + 1):sub(3,4) end
if S:sub(13,13) == 'L' then Date = Date .. ' (calculated)'
elseif S:sub(13,13) == 'E' then Date = Date .. ' (estimated)' end
-- convert to Date object and back to avoid formatting errors (circa, Q dates options)
local dtRM = fhNewDate()
dtRM:SetValueAsText(Date, true)
return dtRM:GetValueAsText()
end
-- *********************************************************************
function FormatUID(UID)
-- converts FH UID format to GEDCOM L format used by RM (32+4)
UID = UID:gsub('-', '')
-- calculate checksum using published method
local a = 0
local b = 0
for i = 1, 31, 2 do
local byte = UID:sub(i, i + 1)
local value = tonumber('0x' .. byte)
a = a + value
b = b + a
end
local cs1 = string.format('%x', a)
local cs2 = string.format('%x', b)
local checksum = cs1:sub(-2) .. cs2:sub(-2)
-- use same case for checksum as for main string
if UID:upper() == UID then checksum = checksum:upper() end
return UID .. checksum
end
-- *********************************************************************
function GetFamilySpouses(pF)
-- convert FH assymetric storage of single sex couples to symmetric
local pH1 = fhGetItemPtr(pF, '~.HUSB[1]')
local pH2 = fhGetItemPtr(pF, '~.HUSB[2]')
local pW1 = fhGetItemPtr(pF, '~.WIFE[1]')
local pW2 = fhGetItemPtr(pF, '~.WIFE[2]')
if pH2:IsNull() and pW2:IsNull() then
return fhGetValueAsLink(pH1), fhGetValueAsLink(pW1)
elseif pH2:IsNotNull() then
return fhGetValueAsLink(pH1), fhGetValueAsLink(pH2)
elseif pW2:IsNotNull() then
return fhGetValueAsLink(pW2), fhGetValueAsLink(pW1)
end
end
-- *********************************************************************
function GetGEDCOMDate(pD)
-- converts FH date to GEDCOM format
local dtD = fhGetValueAsDate(pD)
local S = dtD:GetDisplayText('COMPACT')
-- strip out quotes from date phrases
if S:match('^%"') and S:match('%"$') then
return S:sub(2,-2)
end
S = S:gsub('c%.', 'ABT')
S = S:gsub('btw', 'BET')
S = S:gsub('frm', 'FROM')
local I = S:find('(est)')
if I then S = 'EST ' .. S:sub(1, I - 3) end
I = S:find('(cal)')
if I then S = 'CAL ' .. S:sub(1, I - 3) end
I = S:find('Q1')
if I then S = 'BET JAN ' .. S:sub(4) .. ' AND MAR ' .. S:sub(4) end
I = S:find('Q2')
if I then S = 'BET APR ' .. S:sub(4) .. ' AND JUN ' .. S:sub(4) end
I = S:find('Q3')
if I then S = 'BET JUL ' .. S:sub(4) .. ' AND SEP ' .. S:sub(4) end
I = S:find('Q4')
if I then S = 'BET OCT ' .. S:sub(4) .. ' AND DEC ' .. S:sub(4) end
return S:upper()
end
-- ************************************************************************** --
function GetRegistryKey(key)
local sh = luacom.CreateObject 'WScript.Shell'
local ans
if pcall(function () ans = sh:RegRead(key) end) then
return ans
else
return nil,true
end
end
-- *********************************************************************
function GetUID(pI)
local UID = fhGetItemText(pI, '~._UID')
return FormatUID(UID)
end
-- *********************************************************************
function FHUpdated(RefTime)
-- returns true if any Individual or Family records have been updated since RefTime
local p = fhNewItemPtr()
for _, RecType in ipairs({'INDI', 'FAM'}) do
p:MoveToFirstRecord(RecType)
while p:IsNotNull() do
local D, H, M = fhCallBuiltInFunction('LastUpdated', p)
if not D:IsNull() then
local T = os.time{year=D:GetYear(), month=D:GetMonth(), day=D:GetDay(), hour=H, min=M}
if T > RefTime then return true end
end
p:MoveNext()
end
end
end
-- *********************************************************************
function MessageBox(Message, Buttons, Icon, Title, Default)
-- replaces built-in function with custom version containing more options
-- set message
local msgdlg = iup.messagedlg{value = Message, buttons = Buttons, dialogtype = Icon,
title = Title or 'Ancestry Synchronization', buttondefault = Default}
-- display message box and return selection
msgdlg:popup()
return tonumber(msgdlg.ButtonResponse)
end
-- *********************************************************************
function ProgressBarIncrement(Title)
-- increment progress bar
gblProgBar.Action = Title
gblProgBar.Dialog.title = Title .. '...'
gblProgBar.bar.Value = gblProgBar.bar.Value + 1
-- write log
local step = tonumber(gblProgBar.bar.Value)
local log = step .. ',' .. Title .. ',' .. os.time() - gblProgBar.Start ..
',' .. string.format('%.0f', (collectgarbage('count')))
table.insert(gblProgBar.Log, log)
fhSaveTextFile(gblProgBar.LogFile, table.concat(gblProgBar.Log, '\n') .. '\n')
end
-- *********************************************************************
function ProgressBarStart(Max)
-- create and display a simple progress bar, and store in a global table
gblProgBar = {}
gblProgBar.bar = iup.progressbar{max = Max; rastersize = '400x30'}
gblProgBar.vbox = iup.vbox{gblProgBar.bar; gap = 20, alignment = 'acenter', margin = '5x15'}
gblProgBar.Dialog = iup.dialog{gblProgBar.vbox; title = '', dialogframe = 'Yes', border = 'Yes',
menubox = 'No'}
gblProgBar.Start = os.time()
gblProgBar.Response = os.time()
gblProgBar.Log = {}
gblProgBar.LogFile = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Plugin Data\\Ancestry Sync Log.csv'
table.insert(gblProgBar.Log, 'Step,Action,Time,RAM')
gblProgBar.Dialog:showxy(iup.CENTER, iup.CENTER) -- Put up Progress Display
end
-- *********************************************************************
function ProgressBarUpdate(count, descriptor)
-- update progress bar with ongoing count
gblProgBar.Dialog.title = gblProgBar.Action .. ' (' .. count .. ' ' ..
(descriptor or 'Records') .. ')...'
local now = os.time()
if now - gblProgBar.Response > 3 then
fhExhibitResponsiveness()
gblProgBar.Response = now
end
end
-- *********************************************************************
main()
Source:Ancestry-Synchronization-11.fh_lua