Lumped Source Splitter.fh_lua

--[[
@Title:       Lumped Source Splitter
@Type:        Standard
@Author:      Mark Draper
@Version:     1.1
@LastUpdated: 20 Aug 2021
@Licence:     This plugin is copyright (c) 2021 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: Converts a lumped source to individual split sources.  Citations are regarded as equivalent
if they have identical Where within Source and Text from Source (or Citation level fields for Templated
Sources), and the same attached Media or Note Records.  All of these items are moved to the new split
source and the original lumped citation deleted. 
]]

function main()

	local Message = 'This plugin converts a lumped source into individual split sources and recombines ' ..
		'duplicated\ncitations created during import from another genealogy application.\n\n' ..
		'Please select required action (close window to end plugin):'

	repeat
		local tblS = {}

		Option = iup.Alarm('Lumped Source Splitter (ver 1.1)', Message,
			'Single Source' ,'Multiple Sources', 'Help')

		if Option == 1 then
			tblS = fhPromptUserForRecordSel('SOUR', 1)
			ProcessSources(tblS)
		elseif Option == 2 then
			tblS = fhPromptUserForRecordSel('SOUR')
			ProcessSources(tblS)
		elseif Option == 3 then
			fhShellExecute('https://pluginstore.family-historian.co.uk/help/lumped-source-splitter')
			fhSleep(1000) 			-- slight pause to suspend immediate redraw
		else
			return
		end
	until false
end

-- ************************************************************************** --

function ProcessSources(tblS)

	local tblDelete = {}
	local complete = false		-- flag to suppress completion message if no sources converted

	if #tblS == 0 then return end

	for Count, pSource in ipairs(tblS) do
		local tblCitations = {}
		local SourceTitle = fhGetItemText(pSource, '~.ABBR')
		if SourceTitle == '' then SourceTitle = fhGetItemText(pSource, '~.TITL') end

		repeat
			-- check for possible RootsMagic template

			if fhGetItemPtr(pSource, '~._TMPLT'):IsNotNull() then
				local Msg = SourceTitle .. ' may have been imported from RootsMagic, and contains data ' ..
				'in UDF fields that are not properly assigned by Family Historian or copied by this ' ..
				'plugin, resulting in potential data loss.\n\nYou are recommended to import ' ..
				'RootsMagic source templates from your GEDCOM file in order to restore these data ' ..
				'prior to splitting the source.\n\n'
				if fhMessageBox(Msg, 'MB_OKCANCEL', 'MB_ICONEXCLAMATION') == 'Cancel' then return
					else break end
			end

			-- check for more general UDF fields

			if CheckUDF(pSource) then
				local Msg = SourceTitle .. ' has Undefined Data Fields (UDF), probably from importing ' ..
				'unrecognised data into Family Historian.\n\nThese will not be copied to any new ' ..
				'split sources created by this plugin.  Are you sure you want to split this source?'
				local Response = fhMessageBox(Msg, 'MB_YESNOCANCEL', 'MB_ICONQUESTION')
				if Response == 'Cancel' then return elseif Response == 'No' then break end
			end

			-- find citations to selected source

			local Citations = CountCitations(pSource, tblCitations)

			if Citations < 1 then
				local Msg = SourceTitle .. ' has no lumped citations!'
				if fhMessageBox(Msg, 'MB_OKCANCEL', 'MB_ICONEXCLAMATION') == 'Cancel' then
					return else break end
			elseif Citations == 1 then
				local Msg = SourceTitle .. ' has just one lumped citation, which will be converted to ' ..
				'source level data.\n\nProcess this source ('  .. Count .. ' of ' .. #tblS .. ')?'
				local Response = fhMessageBox(Msg, 'MB_YESNOCANCEL', 'MB_ICONQUESTION')
				if Response == 'Cancel' then return elseif Response == 'No' then break end
			else
				local Msg = SourceTitle .. ' has ' .. Citations .. ' unique lumped citations.\n\n' ..
				'Process this source (' .. Count .. ' of ' .. #tblS .. ')?'
				local Response = fhMessageBox(Msg, 'MB_YESNOCANCEL', 'MB_ICONQUESTION')
				if Response == 'Cancel' then return elseif Response == 'No' then break end
			end

			-- create new split sources from citation fingerprints

			local tblNewSources = CreateNewSources(pSource, tblCitations)
			if not tblNewSources then return end

			-- link new sources to cited records and facts

			LinkNewSources(pSource, tblNewSources, tblCitations)

			-- copy unused source pointer ready for deletion

			if fhCallBuiltInFunction('LinksTo', pSource) == 0 then
				table.insert(tblDelete, pSource:Clone()) end

			complete = true			-- at least one source has been converted
		until true
	end

	-- delete original unused lumped sources

	if #tblDelete > 0 then
		local Msg = 'Do you want to delete any unlinked lumped sources that are now redundant?'
		if fhMessageBox(Msg, 'MB_YESNO', 'MB_ICONQUESTION') == 'Yes' then
			for _, v in ipairs(tblDelete) do fhDeleteItem(v) end
		end
	end

	if complete then fhMessageBox('Source conversion completed.', 'MB_OK', 'MB_ICONINFORMATION') end
end

-- ************************************************************************** --

function CountCitations(pSource, tblCitations)

	local tblRecords = {'INDI', 'FAM', 'OBJE'}
	local p = fhNewItemPtr()
	local pR = fhNewItemPtr()
	local Count = 0

	-- get citations for record and record facts

	for _, RecordType in ipairs(tblRecords) do
		pR:MoveToFirstRecord(RecordType)
		while pR:IsNotNull() do
			GetSources(pR, pSource, tblCitations)
			p:MoveToFirstChildItem(pR)
			while p:IsNotNull() do
				GetSources(p, pSource, tblCitations)
				p:MoveNext()
			end
			pR:MoveNext('SAME_TAG')
		end
	end

	for k, _ in pairs(tblCitations) do if k then Count = Count + 1 end end

	return Count
end

-- ************************************************************************** --

function GetSources(p, pSource, tblCitations)

	-- get sources for the Record or Fact pointed to by p

	local pS = fhNewItemPtr()

	pS:MoveTo(p, '~.SOUR')
	while pS:IsNotNull() do
		local pL = fhGetValueAsLink(pS)
		if pL:IsSame(pSource) then
			local k, v = GetCitationFingerprint(pS)
			if k and v then	tblCitations[k] = v end			-- assigns unique key for distinct citation
		end
		pS:MoveNext('SAME_TAG')
	end
end

-- ************************************************************************** --

function GetCitationFingerprint(pS)

	local p = fhNewItemPtr()
	local pSource = fhGetValueAsLink(pS)

	local tblF = {}		-- table of pointers representing a citation
	local key = ''		-- text representation of pointers for easy comparison
	local tblFields = {}

	if (fhGetItemPtr(pSource, '~._SRCT'):IsNotNull()) then
		tblFields = {'~.DATA.TEXT', '~.OBJE', '~.NOTE', '~.NOTE2', '~._FIELD'}
	else
		tblFields = {'~.PAGE', '~.DATA.TEXT', '~.OBJE', '~.NOTE', '~.NOTE2'}
	end

	for _, Field in ipairs(tblFields) do
		p:MoveTo(pS, Field)
			while p:IsNotNull() do
			local pF = p:Clone()		
			table.insert(tblF, pF)
		key = key .. fhGetDisplayText(p)
			p:MoveNext('SAME_TAG')
		end
	end
	if key ~= '' and #tblF > 0 then return key, tblF end
end

-- ************************************************************************** --

function CreateNewSources(pSource, tblCitations)

	local p = fhNewItemPtr()
	local pTitle = fhNewItemPtr()

	local tblFields = {'TITL', 'ABBR', 'REPO', 'AUTH', '_TYPE', '_SRCT', 'NOTE', 'OBJE'}
	local tblT = {}
	local TemplatedSource = false
	local tblTitleFields = {}
	local tblTitleModifier = {}

	-- define name for templated source

	p:MoveTo(pSource, '~._SRCT')
	if p:IsNotNull() then				-- templated source
		TemplatedSource = true
		tblTitleFields = GetTemplatedTitle(pSource)
		if tblTitleFields == -1 then return end		-- user cancelled
	end

	-- loop through each citation fingerprint to create and populate a new source

	for key, Citation in pairs(tblCitations) do

		-- create new Source Record

		local pS = fhCreateItem('SOUR')
		tblT[key] = fhGetRecordId(pS)	-- link unique fingerprint to newly created Source Record
		tblTitleModifier = {}			-- clear any old title modifier

		-- copy selected regular fields

		for _, Field in ipairs(tblFields) do
			p:MoveTo(pSource, '~.' .. Field)
			while p:IsNotNull() do
				local pNew = fhCreateItem(Field, pS)
				fhSetValue_Copy(pNew, p)
				p:MoveNext('SAME_TAG')
			end
		end

		-- copy source level metafields
				
		p:MoveTo(pSource, '~._FIELD')
		while p:IsNotNull() do
			local pNew = fhCreateItem(fhGetMetafieldShortcut(p), pS)
			fhSetValue_Copy(pNew, p)
			p:MoveNext('SAME_TAG')
		end

		-- process each pointer according to its label

		for _, pC in ipairs(Citation) do
			if fhGetDisplayText(pC):find('^Where Within Source: ') then
				p = fhCreateItem('PUBL', pS)
				fhSetValue_Copy(p, pC)
			elseif fhGetDisplayText(pC):find('^Text from Source: ') or 
				fhGetDisplayText(pC):find('^Text From Source: ') then
				p:MoveTo(pS, '~.TEXT')
				if p:IsNotNull() then			-- TEXT exists already
					fhSetValueAsText(p, fhGetValueAsText(p) .. '\n\n-----\n\n' .. fhGetValueAsText(pC))
				else
					p = fhCreateItem('TEXT', pS)
					fhSetValue_Copy(p, pC)
				end
			elseif fhGetDisplayText(pC):find('^Media Record: ') or 
				fhGetDisplayText(pC):find('^Multimedia Object: ') then
				p = fhCreateItem('OBJE', pS)
				fhSetValue_Copy(p, pC)
			elseif fhGetDisplayText(pC):find('^Note: ') then
				p = fhCreateItem('NOTE2', pS)
				fhSetValue_Copy(p, pC)
			elseif fhGetDisplayText(pC):find('^Note Record: ') then
				p = fhCreateItem('NOTE', pS)
				fhSetValue_Copy(p, pC)
			end

			-- prepare source title modifier using selected data fields

			for k, Field in ipairs(tblTitleFields) do
				local Label = '^' .. Field .. ': '
				if fhGetDisplayText(pC):find(Label) then
					local FieldValue = fhGetDisplayText(pC):sub(Label:len())
					table.insert(tblTitleModifier, ': ' .. FieldValue)
				end
			end
		end

		-- modify source title and populate Pub Info field

		if #tblTitleModifier > 0 then
			p:MoveTo(pS, '~.TITL')
			if p:IsNotNull() then fhSetValueAsText(p, fhGetValueAsText(p) .. 
					table.concat(tblTitleModifier)) end
			p:MoveTo(pS, '~.ABBR')
			if p:IsNotNull() then fhSetValueAsText(p, fhGetValueAsText(p) .. 
					table.concat(tblTitleModifier)) end
		elseif not TemplatedSource then			-- generic source
			p:MoveTo(pS, '~.PUBL')
			if p:IsNotNull() then
				local Modifier = fhGetValueAsText(p)
				p:MoveTo(pS, '~.TITL')
				if p:IsNotNull() and Modifier then fhSetValueAsText(p, fhGetValueAsText(p) .. ': ' ..
						Modifier) end
				p:MoveTo(pS, '~.ABBR')
				if p:IsNotNull() and Modifier then fhSetValueAsText(p, fhGetValueAsText(p) .. ': ' ..
						Modifier) end
			end
		end
	end

	return tblT			-- return table of new sources
end

-- ************************************************************************** --

function LinkNewSources(pSource, tblNewSources, tblCitations)

	local tblRecords = {'INDI', 'FAM', 'OBJE'}
	local p = fhNewItemPtr()
	local pR = fhNewItemPtr()

	-- get citations for record and record facts

	for _, RecordType in ipairs(tblRecords) do
		pR:MoveToFirstRecord(RecordType)
		while pR:IsNotNull() do
			LinkNewCitations(pR, nil, pSource, tblNewSources, tblCitations)
			p:MoveToFirstChildItem(pR)
			while p:IsNotNull() do
				LinkNewCitations(p, pR, pSource, tblNewSources, tblCitations)
				p:MoveNext()
			end
			pR:MoveNext('SAME_TAG')
		end
	end
end

-- ************************************************************************** --

function LinkNewCitations(pFact, pParent, pSource, tblNewSources, tblCitations)

	local p = fhNewItemPtr()
	local pS = fhNewItemPtr()
	local pSplitSource = fhNewItemPtr()

	local tblX = {}					-- bin pending deletion

	pS:MoveTo(pFact, '~.SOUR')
	while pS:IsNotNull() do
		local pL = fhGetValueAsLink(pS)
		if pL:IsSame(pSource) then
			local key, _ = GetCitationFingerprint(pS)
			if not key then return end			-- do not process non-lumped citations
			pSplitSource:MoveToRecordById('SOUR', tblNewSources[key])

			-- create new source link

			local pNewSource = fhCreateItem('SOUR', pFact)
			fhSetValueAsLink(pNewSource, pSplitSource)

			-- delete redundant fields in lumped source citation

			local tblFields = {'~.PAGE', '~.DATA.TEXT', '~.OBJE', '~.NOTE', '~.NOTE2'}

			for _, Field in ipairs(tblFields) do
				p:MoveTo(pS, Field)
				while p:IsNotNull() do
					local pX = p:Clone()
					table.insert(tblX, pX)
					p:MoveNext('SAME_TAG')
				end
			end

			for _, pX in ipairs(tblX) do fhDeleteItem(pX) end		-- empty the rubbish bin

			-- delete DATA field if no children

			p:MoveTo(pS, '~.DATA')
			if not fhHasChildItem(p) then
				local pX = p:Clone()
				fhDeleteItem(pX)				
			end

			-- copy any remaining lumped citation fields to new citation

			p:MoveToFirstChildItem(pS)
			while p:IsNotNull() do
				local Tag = fhGetTag(p)
				if Tag == '_FIELD' then Tag = fhGetMetafieldShortcut(p) end
				local pNew = fhCreateItem(Tag, pNewSource)
				fhSetValue_Copy(pNew, p)
				p:MoveNext()
			end

			-- process any citation Entry Date

			p:MoveTo(pS, '~.DATA.DATE')
			if p:IsNotNull() then
				local pData = fhNewItemPtr()
				pData:MoveTo(pNewSource, '~.DATA')
				local pDate = fhCreateItem('DATE', pData)
				fhSetValue_Copy(pDate, p)
			end

			-- finally, delete old lumped citation

			local pX = pS:Clone()
			table.insert(tblX, pX)
		end
		pS:MoveNext('SAME_TAG')
	end

	for _, pX in ipairs(tblX) do fhDeleteItem(pX) end		-- final empty of the rubbish bin
end

-- ************************************************************************** --

function GetTemplatedTitle(pSource)

	local tblFields = {}											-- ordered list of field names
	local tblTitleFields = -1										-- function return value
	local pT = fhGetValueAsLink(fhGetItemPtr(pSource, '~._SRCT'))	-- pointer to Source Template

	-- get citation level fields to include in new source title

	local pF = fhNewItemPtr()

	pF:MoveToFirstChildItem(pT)
	while pF:IsNotNull() do
		if fhGetTag(pF) == 'FDEF' then
			local pN = fhGetItemPtr(pF, '~.NAME')
			if fhGetItemPtr(pF, '~.CITN'):IsNotNull() then
				table.insert(tblFields, fhGetValueAsText(pN))
			end
		end
		pF:MoveNext()
	end

	-- start assembling the iup dialogue

	local H = 'Select up to three Citation Level fields to be used in naming the new split Source Record'
	local Heading = iup.label{title=H; size='x20'}

	local Include = iup.toggle{title='Include field name in Source Title?', value='On',
			rightbutton='Yes', size='x20'}

	local lst1 = iup.list{'(none selected)', dropdown='Yes', size=200, value=1,
			VisibleItems=10, tip='Select first field'}
	for k, v in ipairs(tblFields) do lst1[k+1] = v end
	local Field1 = iup.hbox{iup.label{title='First Field:',size='60'}, lst1}

	local lst2 = iup.list{'(none selected)', dropdown='Yes', size=200, value=1,
			VisibleItems=10, tip='Select second field', active='No'}
	local Field2 = iup.hbox{iup.label{title='Second Field:',size='60'}, lst2}

	local lst3 = iup.list{'(none selected)', dropdown='Yes', size=200, value=1,
			VisibleItems=10, tip='Select third field', active='No'}
	local Field3 = iup.hbox{iup.label{title='Third Field:',size='60'}, lst3}

	local btnOK = iup.button{title = 'OK', tip='Process split', active='No'}
	local btnCancel = iup.button{title = 'Cancel', tip='Cancel split'}

	local Buttons = iup.hbox{iup.fill{}, btnOK, btnCancel, iup.fill{};
			margin='0x20', normalizesize='Horizontal', padding=10, gap=20}

	local Container = iup.vbox{Heading, Include, Field1, Field2, Field3, Buttons; gap=5, margin='20x0'}


	local dlg = iup.dialog{Container, title = 'Templated Source name definition'; 
			resize='No', maxbox = 'No', minbox = 'No'}

	-- define list callbacks

	function lst1:valuechanged_cb()
		lst2.RemoveItem = 'All'
		lst2.AppendItem = '(none selected)'
		for k, v in ipairs(tblFields) do if v ~= lst1[lst1.value] then lst2.AppendItem = v end end
		lst2.value = 1
		if tonumber(lst1.value) > 1 then lst2.active = 'Yes' else lst2.active = 'No' end
		btnOK.active = lst2.active
		lst3.value = 1
		lst3.active = 'No'
	end

	function lst2:valuechanged_cb()
		lst3.RemoveItem = 'All'
		lst3.AppendItem = '(none selected)'
		for k, v in ipairs(tblFields) do 
			if v ~= lst1[lst1.value] and v ~= lst2[lst2.value] then lst3.AppendItem = v end end
		lst3.value = 1
		if tonumber(lst2.value) > 1 then lst3.active = 'Yes' else lst3.active = 'No' end
	end

	-- define button callbacks

	function btnOK:action()
		tblTitleFields = {}
		if tonumber(lst1.value) > 1 then table.insert(tblTitleFields, lst1[lst1.value]) end
		if tonumber(lst2.value) > 1 then table.insert(tblTitleFields, lst2[lst2.value]) end
		if tonumber(lst3.value) > 1 then table.insert(tblTitleFields, lst3[lst3.value]) end
 		return iup.CLOSE
	end

	function btnCancel:action()
		return iup.CLOSE
	end

	dlg:showxy(iup.CENTER,iup.CENTER)
	iup.MainLoop()

	dlg:destroy()

	return tblTitleFields
end

-- ************************************************************************** --

function CheckUDF(pSource)

	local p = fhNewItemPtr()

	p:MoveToFirstChildItem(pSource)
	while p:IsNotNull() do
		if fhIsUDF(p) then return true end
		p:MoveNext()
	end
end

-- ************************************************************************** --

fhInitialise(5,0,0, 'save_recommended')

require('iuplua')
iup.SetGlobal('CUSTOMQUITMESSAGE','YES')

main()

Source:Lumped-Source-Splitter-1.fh_lua