Convert File Links.fh_lua

--[[
@Title: Convert File Links 
@Author: Jane Taubman
@LastUpdated: 25 March 2013
@Version: 1.5
@Description: Converts all object links to portable ones, creating cut out images for multimedia objects which have partial links.


It will only work on an "exported" gedcom file with full media paths, to prevent accidentally converting a project.

The resulting file can be imported to a variety of programs including Rootsmagic or uploaded to web supporting software like TNG.

Note: When the file is converted, FH will not display the media until the file is reloaded.

V1.1  Added progress display and converted after removal of fhGetItemText function.
V1.2  Handle Crop Rectangles which end outside the frame, tidy debug prints.
V1.3 Add options to support copy of non image files.
V1.4 Handle non-image & missing media, more cropping fixes, other minor updates (with thanks to Mike Tate).
V1.5 Correct Maximum Size handing for partial images.
]]
ProgressDisplay = {

	Start = function(strTitle)
		cancelflag = false
		local cancelbutton = iup.button {
			title = "Cancel",
			size = "100x15",
			action=function()
				cancelflag = true
				return iup.CLOSE
			end
		}
		gaugeProgress = iup.progressbar{size = "250x12"}
		messageline   = iup.label{expand="HORIZONTAL",title=" ",alignment="ACENTER",gap=10} 
		dlgProgress = iup.dialog{
			title = strTitle,
			dialogframe = "YES", border = "YES",
			iup.vbox {
				messageline,
				gaugeProgress,
				cancelbutton,
				alignment="ACENTER",gap="10",margin="8x8"
			}
		}
		dlgProgress.menubox = "NO"  --  Remove Windows close button and menu.
		dlgProgress.close_cb = cancelbutton.action
		dlgProgress:showxy(iup.CENTER, iup.CENTER)  --  Put up Progress Display
	end,

	Step = function(iStep)
		gaugeProgress.value = gaugeProgress.value + iStep
		local value = tonumber(gaugeProgress.value)
		if value >= 1 then
			gaugeProgress.value  = 0
		end
		iup.LoopStep()
	end,

	Close = function()
		dlgProgress:destroy()
	end,

	Cancel = function()
		return cancelflag
	end,

	SetMessage = function(strMessage)
		messageline.title = strMessage
	end,

	Reset = function()
		gaugeProgress.value = 0
	end
}

function CopyMediaFile(strSource,strTarget)
	local fileSource = assert(io.open(strSource,"rb"))
	local fileTarget = assert(io.open(strTarget,"wb"))
	fileTarget:write(fileSource:read("*all"))				-- Copy entire file contents
	assert(fileSource:close())
	assert(fileTarget:close())
end

function ProcessImageFile(orgfile,destfile,y1,x1,y2,x2,maxheight,maxwidth)
	local ya,yb
	image, err = im.FileImageLoad(orgfile)
	if (err and err ~= im.ERR_NONE) then
		local TblError = {}
		TblError[im.ERR_OPEN]		= "Error while opening the file."
		TblError[im.ERR_ACCESS]	= "Error while accessing the file."
		TblError[im.ERR_FORMAT]	= "Invalid or unrecognized file format."
		TblError[im.ERR_DATA]		= "Invalid or unsupported data."
		TblError[im.ERR_COMPRESS]	= "Invalid or unsupported compression."
		TblError[im.ERR_MEM]		= "Insufficient memory."
		fhMessageBox("File Image Load: "..TblError[err].."\n\nCopying image file without cropping:\n\n"..orgfile)
		dlgProgress.bringfront = "YES"
		CopyMediaFile(orgfile,destfile)
		return
	end
	local w=image:Width()
	local h=image:Height()
	local a=y1 or 0
	local b=x1 or 0
	local c=y2 or 0
	local d=x2 or 0

	if y1 == nil then
		-- Full image copy no Crops
		x1, x2, ya, yb = 0, w-1, 0, h-1
	else
		-- bottom up for Y
		ya = h - y2
		yb = h - y1 - 1
	end
	-- Check for Crops outside of the range
	if x1 < 0 then x1 = 0 end
	if x2 < 0 then x2 = 0 end
	if x1 >= w then x1 = w-1 end
	if x2 >= w then x2 = w-1 end
	if yb >= h then yb = h-1 end
	if ya >= h then ya = h-1 end
	if ya < 0 then ya = 0 end
	if yb < 0 then yb = 0 end

	isOK, new_image = pcall(im.ProcessCropNew, image, x1, x2, ya, yb)
	if isOK then
		if maxwidth ~= nil or maxheight ~= nil then
			if (new_image:Height() > maxwidth) or (new_image:Width() > maxwidth) then
				new_image = resize(new_image,maxwidth,maxheight)
			end
		end
		new_image:Save(destfile, "JPEG")
		new_image:Destroy()
		image:Destroy()
	else
		-- Report error message held in 'new_image' with other diagnostic details
		fhMessageBox("Process Crop Error\n\nImage File: "..orgfile.."\n\nImage _AREA {"..a..","..b..","..c..","..d.."}\n\n"..new_image.."\n\nArgs  #2: "..x1.."  #3: "..x2.."  #4: "..ya.."  #5: "..yb.."  width: "..w.."  height: "..h)
		dlgProgress.bringfront = "YES"
	end
end

function resize(image,maxwidth,maxheight)
	local w = maxwidth
	local h = maxheight

	for i = 1, 4 do
		local img_w = image:Width()
		local img_h = image:Height()
		local aspect = maxwidth / maxheight
		if (img_w ~= w or h ~= h) then
			local rz_w, rz_h, img_aspect

			img_aspect = img_w/img_h

			-- keep image aspect ratio
			if (img_aspect ~= aspect) then
				if (img_aspect < aspect) then
					rz_h = h
					rz_w = math.floor(rz_h * img_aspect)
				else
					rz_w = w
					rz_h = math.floor(rz_w / img_aspect)
				end
			else
				rz_w = w
				rz_h = h
			end

			if (img_w ~= rz_w or img_h ~= rz_h) then
				resize_image = im.ImageCreate(rz_w, rz_h, image:ColorSpace(), image:DataType())
				im.ProcessResize(image, resize_image, 1) -- do bilinear interpolation
				image:Destroy()
				image = resize_image
			end
		end
	end
	return image
end

function string.starts(String,Start)
	return string.sub(String,1,string.len(Start))==Start
end

function splitfilename(strfilename)
	return string.match(strfilename, "(.-)([^\\]-([^%.]+))$")
end

function DoAllItems(strType,tblClass,action)
	-- strType: Main Item Type (eg text)
	-- strClass:  Keyworded Array of Classes
	-- action:    function to perform
	local iCount = fhGetRecordTypeCount() -- Get Count of Record types
	-- Loop through Record Types
	local ii = 0
	local ptr = fhNewItemPtr()
	local tmpptr = fhNewItemPtr()
	for ii =1,iCount do
		strRecType = fhGetRecordTypeTag(ii)
		ptr:MoveToFirstRecord(strRecType)
		while ptr:IsNotNull() do
			strDataClass = fhGetDataClass(ptr)
			if fhGetTag(ptr) == strType and tblClass[fhGetDataClass(ptr)] == true then
				action(ptr)
			end
			ptr:MoveNextSpecial()
		end
	end
end

function replaceObj(ptr)	
	ProgressDisplay.SetMessage(fhGetDisplayText(ptr))
	ProgressDisplay.Step(iStep)
	if ProgressDisplay.Cancel() then
		-- Quit Logic
		error('Process Cancelled')
	end
	local key
	local rcdPtr = fhNewItemPtr()
	local linkPtr = fhNewItemPtr()
	local parentPtr = fhNewItemPtr()
	local newObjPtr = fhNewItemPtr()
	local newFieldPtr = fhNewItemPtr()
	rcdPtr = fhGetValueAsLink(ptr)
	linkPtr:MoveTo(ptr,'~._ASID')
	strASID = fhGetValueAsText(linkPtr)
	if strASID == nil or strASID == '' then
		strASID = '0'
	end
	parentPtr:MoveToParentItem(ptr) 
	if rcdPtr:IsNotNull() then
		-- Found record link OBJECT
		key = fhGetRecordId(rcdPtr)..'-'..strASID
		object = tblFileList[key]
		if object == nil then
			error('No Object Data Found')
		end
		--- Add New Direct Object
		newObjPtr = fhCreateItem('OBJE2',parentPtr)
		fhSetValueAsText(newObjPtr,'')
		newFieldPtr:MoveTo(newObjPtr,'~.FORM')
		if newFieldPtr:IsNull() then
			newFieldPtr = fhCreateItem('FORM',newObjPtr)
		end
		fhSetValueAsText(newFieldPtr,object.form)
		newFieldPtr:MoveTo(newObjPtr,'~.FILE')
		if newFieldPtr:IsNull() then
			newFieldPtr = fhCreateItem('FILE',newObjPtr)
		end
		fhSetValueAsText(newFieldPtr,object.filename)
		newFieldPtr = fhCreateItem('TITL',newObjPtr)
		fhSetValueAsText(newFieldPtr,object.title)
		table.insert(tblObjList,ptr:Clone())
	end
end

function trim(s)
	return (s:gsub("^%s*(.-)%s*$", "%1"))
end

function CountMedia()
	local ptrCount = fhNewItemPtr()
	local count = 0
	ptrCount:MoveToFirstRecord('OBJE')
	while ptrCount:IsNotNull() do
		count = count + 1
		ptrCount:MoveNext()
	end
	-- Return as reciprical to step the gaugeProgress
	return count
end

--------------------------------------------------------- Main Code
require "lfs"
require "imlua"
require "imlua_process"
context = fhGetContextInfo('CI_APP_MODE')
if context ~= 'Gedcom Mode' then
	fhMessageBox('Please export your Project using the Export Option first'..
	' and open the exported Gedcom before running this plugin')
	return
end
exportFolder = splitfilename(fhGetContextInfo('CI_GEDCOM_FILE'))
bOk,exportFolder,maxheight,maxwidth = iup.GetParam('Export Image Options',iup.NULL,
	'Please select the folder for the media %t \n'..
	'Media Folder %f[DIR||'..exportFolder..'] \n'..
	'Maximum Height %i \n'..
	'Maximum Width %i \n',
	exportFolder,600,600
	)
if bOk == false then
	return
end
-- IUP sometimes adds white space and new lines so trim them and ensure one and only one backslash.
exportFolder = trim(exportFolder)..'\\'
exportFolder = exportFolder:gsub('\\\\','\\')
lfs.mkdir(exportFolder)
tblFileList = {}
ptrRecord = fhNewItemPtr()
ptrField  = fhNewItemPtr()
tblObjList = {}

------------------------------------------ Stage One Process All Attached Images
ProgressDisplay.Start('Converting Images')
iStep = 1 / CountMedia()
ptrRecord:MoveToFirstRecord('OBJE')
ptrWork = fhNewItemPtr()
while ptrRecord:IsNotNull() do
	rcdId = fhGetRecordId(ptrRecord)
	ptrWork:MoveTo(ptrRecord,'~._FILE')
	strFileName = fhGetValueAsText(ptrWork)
	strRecord = fhGetRecordId(ptrRecord)
	ptrWork:MoveTo(ptrRecord,'~.FORM')
	strForm = fhGetValueAsText(ptrWork)
	ptrWork:MoveTo(ptrRecord,'~.TITL')
	strTitle = fhGetValueAsText(ptrWork)
	local path,name,ext = splitfilename(strFileName)
	name = name or ""
	ptrField:MoveTo(ptrRecord,'~.NOTE2')
	ProgressDisplay.SetMessage(name:gsub("&","&&"))
	ProgressDisplay.Step(iStep)
	if ProgressDisplay.Cancel() then
		error('Process Cancelled')
	end
	-- Check whether Multimedia Object is an image format file
	local strFormat = string.lower(strForm)
	local isImage = false
	for i, strType in ipairs({"bmp","gif","ico","jpg","jpeg","pcx","png","tif","tga","tiff"}) do
		if string.match(strFormat,strType) then
			isImage = true
			break
		end
	end
	while ptrField:IsNotNull() do
		ptrWork:MoveTo(ptrField,'~._ASID')
		strASID = fhGetValueAsText(ptrWork)
		ProgressDisplay.SetMessage(name:gsub("&","&&")..' '..strASID)
		ptrWork:MoveTo(ptrField,'~._AREA')
		strArea = fhGetValueAsText(ptrWork)
		if strFileName:starts('Media\\') then
			fhMessageBox('File contains Project file links please ensure export done with Full Paths - Process Aborted')
			return
		end
		a,b,c,d = string.match(strArea,'{(.-),(.-),(.-),(.-)}')
		if a == nil then fASID = '0' else fASID = strASID end	
		outFile = exportFolder..'O'..rcdId..'-'..fASID..'-'..name
		if lfs.attributes(strFileName,"mode") == "file" then	-- File exists
			if isImage then
				ProcessImageFile(strFileName,outFile,tonumber(a),tonumber(b),tonumber(c),tonumber(d),maxheight,maxwidth)
			else -- Audio/Video/Word-processor file
				CopyMediaFile(strFileName,outFile)
			end
		else
			if strFileName ~= "" then
				fhMessageBox("Skipping missing multimedia file:\n\n"..strFileName)
				dlgProgress.bringfront = "YES"
			end
		end
		tblFileList[rcdId..'-'..strASID] = {recordId=rcdID,asid=fASID,filename=outFile,form=strForm,title=strTitle}
		ptrField:MoveNext('SAME_TAG')
	end
	outFile = exportFolder..'O'..rcdId..'-0-'..name
	if lfs.attributes(strFileName,"mode") == "file"	-- Input file exists
	and not lfs.attributes(outFile,"mode") then		-- Output file missing
		if isImage then ProcessImageFile(strFileName,outFile,nil,nil,nil,nil,maxheight,maxwidth) end
	end
	tblFileList[rcdId..'-0'] = {recordId=rcdID,asid='0',filename=outFile,form=strForm,title=strTitle}
	table.insert(tblObjList,ptrRecord:Clone())
	ptrRecord:MoveNext()
end
ProgressDisplay.Reset()
ProgressDisplay.Close()

------------------------------------------ Stage two convert all File Links to Local Links
ProgressDisplay.Start('Remaping Images')
iStep = 1 / #tblFileList
DoAllItems('OBJE',{link=true},replaceObj)
ProgressDisplay.Reset()
ProgressDisplay.Close()

------------------------------------------ Stage 4 delete all object records
for k,ptr in pairs(tblObjList) do
	fhDeleteItem(ptr)
end