Ok, hopefully that's the last version. I really don't want to look into this code anymore < g >

**__RI_HEADER!@ Do NOT REMOVE or MODIFY this line!!!! @!__RI_HEADER**
* Steve Sawyer - Updated 11/22/1999
* Carl Karsten - Updated 12/15/1999
* Doug Hennig  - Updated 02/18/2000

*  Program...........: NEWRI.PRG
*  Author............: Jzanus Dev Team
*  Project...........: Visual Collections
*  Created...........: 04/04/2005  14:28:19
*  Copyright.........: (c) Jzanus LTD, 2005
*) Description.......:
*  Calling Samples...:
*  Parameter List....:
*  Major change list.: Switched from scanning array of relations to table based

* Known limitations:
*	- Cascading updates and deletes for self-joins cause an "illegal recursion"
*		error because the RI code tries to update or delete records in the same
*		table the trigger is fired for, which VFP doesn't allow (all other
*		rules for self-joins are handled correctly)
*	- Compound keys aren't supported

function __RI_Handler(tcTriggerType)

**-- CHANGE - NN - April 04, 2005 - 14:30:12 - added a new global variable
if vartype(m.glDontUseTriggers)="L" and m.glDontUseTriggers
	return && Don't do any validations
endif

local lcTable, ;
	lcAlias, ;
	lcRecordState, ;
	lcTriggerType, ;
	lcDBC, ;
	lcParent, ;
	lcChild, ;
	lcParentKeyExp, ;
	lcChildKeyExp, ;
	lcRIInfo, ;
	luOldKey, ;
	luNewKey, ;
	luOldFK, ;
	luNewFK

* Get the name of the table the trigger was fired for and determine what type
* of trigger was fired.

lcTable       = upper(cursorgetprop('SourceName'))
lcAlias       = alias()
lcRecordState = getfldstate(-1)

#define cnERR_TRIGGER_FAILED 1539
*!*	local cnERR_TRIGGER_FAILED
*!*	cnERR_TRIGGER_FAILED = 1539
* Trigger failed error number

* If the trigger was passed, use it.
if vartype(m.tcTriggerType) = 'C' and not empty(m.tcTriggerType)
	lcTriggerType = upper(m.tcTriggerType)
else
* If the deletion status was changed and the record is deleted, this is a
* "DELETE" trigger.
* Define some constants that'll make the code easier to read.
	local ccFLDSTATE_UNCHANGED, ccFLDSTATE_EDITDEL, ccFLDSTATE_NEWUNCHANGED, ccFLDSTATE_NEWCHANGED
	ccFLDSTATE_UNCHANGED	=   '1'
* GETFLDSTATE() 1 = the field is unchanged
	ccFLDSTATE_EDITDEL		=   '2'
* GETFLDSTATE() 2 = the record was edited or deletion status changed
	ccFLDSTATE_NEWUNCHANGED	 =  '3'
* GETFLDSTATE() 3 = a new unchanged field or new undeleted record
	ccFLDSTATE_NEWCHANGED	=   '4'
* GETFLDSTATE() 3 = a new changed field or new deleted record
	do case
	case left(m.lcRecordState, 1) = ccFLDSTATE_EDITDEL and deleted()
		lcTriggerType = 'DELETE'

* If the deletion status was changed and the record is not deleted, it was
* just recalled, so this is an "INSERT" trigger.

	case left(m.lcRecordState, 1) = ccFLDSTATE_EDITDEL
		lcTriggerType = 'INSERT'

* If this is a new record, this is an "INSERT" trigger.

	case ccFLDSTATE_NEWUNCHANGED $ m.lcRecordState or ;
			ccFLDSTATE_NEWCHANGED $ m.lcRecordState
		lcTriggerType = 'INSERT'

* Some field in the table has been changed, so this is an "UPDATE" trigger.

	case ccFLDSTATE_EDITDEL $ m.lcRecordState
		lcTriggerType = 'UPDATE'

* Carl Karsten found a weird bug in VFP: if you have a table with a memo field
* and delete a record such that the subsequent records have to be physically
* moved when you PACK, the "UPDATE" trigger for the table fires when you move
* the record pointer or close the table. In that case, we'll ignore it.

	case m.lcRecordState = replicate(ccFLDSTATE_NEWUNCHANGED, len(m.lcRecordState))
		return
	endcase
endif

* If we're at the top trigger level, start a transaction, create an error flag
* and array variables, get a snapshot of open tables, and set up the
* environment the way we need it.
local llManualCleanUp, loSession
llManualCleanUp = .f.

if _triggerlevel = 1
	private plError
	plError = .f.
	release gaErrors
	public gaErrors[1, 12]

	llManualCleanUp = .t.
	private paUsed[1], ;
		pcExact, ;
		pcANSI, ;
		pcDeleted, ;
		pcOnEscape, ;
		pcError, ;
		pcOldDBC, plError

	aused(paUsed)
	pcExact  = set('EXACT')
	pcANSI   = set('ANSI')
	pcDeleted = set('DELETED')
	pcError   = on('ERROR')
	pcOnEscape = on('escape')
* this command is not supported in Ole Db
	on escape RICleanUp(.t.)

	set exact on
	set ansi on
	set deleted on
	on error LogRIError(error(),message()) &&plError = .t.
	begin transaction
endif

if vartype(m.plError) = "L" and m.plError
** Error occurred
else
	pcOldDBC = iif(empty(dbc()), '', '"' + dbc() + '"')
	lcDBC    = cursorgetprop('Database')
	set database to (m.lcDBC)
	if not used('RIDefinitions')
		use RIDefinitions in 0 && Open table with RI Definitions
	endif
	local lcChildTag, lcParentTag, lcSearch
	store "" to lcParentKeyExp, lcChildKeyExp, lcParentTag

	lcSearch = padr(m.lcTable,128)
	lcParent = m.lcTable
	select RIDefinitions
	scan for upper(ParentTB) = m.lcSearch and alltrim(ParentTag)<> m.lcParentTag and not m.plError
		lcChild  = alltrim(ChildTB)
		lcParentTag  = alltrim(ParentTag)
		lcChildTag  = alltrim(ChildTag)
		lcChildKeyExp = alltrim(ChildKey)

		do case

* If this is an update trigger and this relation has our table as the parent,
* let's process it. We'll ignore it if the RI rule is empty or "ignore".

		case m.lcTriggerType = 'UPDATE'
			lcRIInfo = UpdTrigger
			if not empty(m.lcRIInfo) and m.lcRIInfo <> 'I'
				if not alltrim(ParentKey) == m.lcParentKeyExp && So it would calculate it only once
					lcParentKeyExp = alltrim(ParentKey)
					select (m.lcAlias)
					luOldKey       = oldval(m.lcParentKeyExp, m.lcAlias)
					luNewKey       = evaluate(m.lcParentKeyExp)
					select RIDefinitions
				endif

* If this is a self-join, we may have an update trigger because the FK field
* in the "child" copy of the table was changed (which really is an insert
* trigger), so let's handle it if we have a restrict insert rule. The reason
* we don't handle it in a CASE below is that the user may have changed both
* the parent and foreign key fields.

				if m.lcParent == m.lcChild && very rare case
					select (m.lcAlias)
					luOldFK = oldval(m.lcChildKeyExp, m.lcAlias)
					luNewFK = evaluate(m.lcChildKeyExp)
					select RIDefinitions
					if m.luOldFK <> m.luNewFK and ;
							substr(m.lcRules, cnRIINFO_INSERT, 1) = 'R'
						Restrict_Insert(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
							m.lcChildKeyExp, m.luNewFK, m.lcTriggerType, m.lcParentTag )
					endif luOldFK <> luNewFK ...
				endif lcParent = lcChild

				do case

* The parent key wasn't changed or an error occurred, so we have nothing to do.

				case m.plError or m.luOldKey = m.luNewKey

* If the parent key has been changed, call the appropriate function, depending
* on whether this is a cascade or restrict rule.

				case m.lcRIInfo = 'C'

					Cascade_Update(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
						m.lcChildKeyExp, m.luOldKey, m.luNewKey)

				case m.lcRIInfo = 'R'
					Restrict_Update(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
						m.lcChildKeyExp, m.luOldKey, m.luNewKey, m.lcChildTag)
				endcase
			endif not empty(lcRIInfo) ...

* If this is a delete trigger and this relation has our table as the parent,
* let's process it. We'll ignore it if the RI rule is empty or "ignore".

		case m.lcTriggerType = 'DELETE'
			lcRIInfo = DelTrigger
			if not empty(m.lcRIInfo) and m.lcRIInfo <> 'I'
				if not alltrim(ParentKey) == m.lcParentKeyExp && So it would calculate it only once
					lcParentKeyExp = alltrim(ParentKey)
					select (m.lcAlias)
					luNewKey          = evaluate(m.lcParentKeyExp)
					select RIDefinitions
				endif

* Call the appropriate function, depending on whether this is a cascade or
* restrict rule.

				do case
				case m.lcRIInfo = 'C'
					Cascade_Delete(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
						m.lcChildKeyExp, m.luNewKey)
				case m.lcRIInfo = 'R'
					Restrict_Delete(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
						m.lcChildKeyExp, m.luNewKey, m.lcChildTag)
				endcase
			endif not empty(lcRIInfo) ...
		endcase
	endscan

** Now do the same for the child
	if inlist(m.lcTriggerType,"INSERT","UPDATE") && there are no restrictions on delete, if it's a child table
		select RIDefinitions
		lcChild = m.lcTable
		lcChildKeyExp = ""
		scan for upper(ChildTB) = m.lcSearch and not m.plError
			lcParent = alltrim(ParentTB)
			lcParentTag  = alltrim(ParentTag)
			lcChildTag  = alltrim(ChildTag)
			lcParentKeyExp = alltrim(ParentKey)

			if vartype(m.pcCascadeParent) = "C" and m.pcCascadeParent = m.lcParent
** In this case we do nothing - otherwise we're burried in recursion
			else

* If this relation has our table as the child, let's process it. We'll only
* process a "restrict" rule in either an insert or update trigger.

				lcRIInfo = InsTrigger
				if m.lcRIInfo = 'R'
					if not m.lcChildKeyExp == alltrim(ChildKey) && we don't want to evaluate more times than needed
						lcChildKeyExp = alltrim(ChildKey)
						select (m.lcAlias)
						luNewKey     = evaluate(m.lcChildKeyExp)
						luOldKey = oldval(m.lcChildKeyExp, m.lcAlias)
						select RIDefinitions
					endif

* If this is an insert trigger or if it's an update trigger and the foreign key
* has changed, call the Restrict_Insert function to ensure the foreign key
* exists in the parent table.

					if m.lcTriggerType = 'INSERT' or m.luOldKey <> m.luNewKey
						Restrict_Insert(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
							m.lcChildKeyExp, m.luNewKey, m.lcTriggerType, m.lcParentTag)
					endif lcTriggerType <> 'UPDATE' ...
				endif lcRIInfo = 'R'
			endif
		endscan
	endif
endif

* If we're at the top trigger level, either end the transaction or roll it
* back, depending on whether the trigger succeeded or not, close any tables we
* opened, restore the things we changed, and return whether we succeeded or
* not.
if _triggerlevel = 1
	if m.llManualCleanUp
		=RICleanUp(.f.)
	else
		if m.plError
			rollback
		else
			end transaction
		endif plError
	endif
* If we're not at the top trigger level, return .T. so we don't trigger an
* error yet.
endif _triggerlevel = 1
return not m.plError

* CleanUp procedure
function RICleanUp(tlEscaped)
if m.tlEscaped and messagebox("Are you sure you want to stop the trigger's execution?",4+16,"Stop execution") = 7
**
	retry
else

	local lnTables, laTables[1], lnI
	if not empty(m.pcOldDBC)
		set database to (m.pcOldDBC)
	endif
	if _triggerlevel = 1
		if m.plError or m.tlEscaped
			rollback
		else
			end transaction
		endif plError
** Gregory Adam suggested in the thread #1002645 to only close tables in Default DS
		if set("Datasession") > 1 && we're dealing with private DS, don't need to close
		else
			lnTables = aused(laTables)
			for lnI = 1 to m.lnTables
				lcTable = laTables[m.lnI, 1]
				if not empty(m.lcTable) and ascan(paUsed, m.lcTable) = 0
					use in (m.lcTable)
				endif not empty(lcTable) ...
			next lnI

		endif
		if m.pcExact = "OFF"
			set exact off
		endif
		if m.pcANSI = "OFF"
			set ansi off
		endif
		if m.pcDeleted = "OFF"
			set deleted off
		endif
		on error &pcError
** this command is not supported in Ole Db
		on escape &pcOnEscape
	endif
endif
return

* Cascade update function: change the foreign key field in all child records
* that belong to the parent record.

function Cascade_Update(tcParentTable, ;
	tcChildTable, ;
	tcParentKey, ;
	tcChildKey, ;
	tuOldKey, ;
	tuNewKey)
local laError[1]

private pcCascadeParent
pcCascadeParent = m.tcParentTable

* Do the cascading update. Log any error that occurred.
if not isnull(m.tuOldKey )
	update (m.tcChildTable) ;
		set &tcChildKey = m.tuNewKey ;
		where &tcChildKey = m.tuOldKey
endif

if m.plError
	aerror(laError)
	LogRIError(laError[1], laError[2], 'Cascade Update', ;
		m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
		m.tcParentKey, m.tuNewKey, ;
		m.tcChildTable, 0, m.tcChildKey, m.tuOldKey)
endif plError
return

* Cascade delete function: delete all child records that belong to the parent
* record.

function Cascade_Delete(tcParentTable, ;
	tcChildTable, ;
	tcParentKey, ;
	tcChildKey, ;
	tuOldKey, ;
	tuNewKey)
local laError[1]

if not isnull(m.tuOldKey)

	delete ;
		from (m.tcChildTable) ;
		where &tcChildKey = m.tuOldKey
endif
if m.plError
	aerror(laError)
	LogRIError(laError[1], laError[2], 'Cascade Delete', ;
		m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
		m.tcParentKey, m.tuNewKey, ;
		m.tcChildTable, 0, m.tcChildKey, m.tuOldKey)
endif plError
return

* Restrict delete function: see if there are any records in the specified child
* table matching the specified key in the parent table.

function Restrict_Delete(tcParentTable, ;
	tcChildTable, ;
	tcParentKey, ;
	tcChildKey, ;
	tuKey, tcTag)
local lcTable

if not isnull(m.tuKey)
	lcTable = strtran(m.tcChildTable, ' ', '_')

	if not used(m.lcTable)
		use (m.tcChildTable) again in 0 shared alias (m.lcTable)
	endif not used(lcTable)
	if indexseek(m.tuKey, .f., m.lcTable, m.tcTag) && Record exists
*	if keymatch(m.tuKey,tagno(m.tcTag, '', m.lcTable), m.lcTable) && Record exists
		plError = .t.
		LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Delete', ;
			m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
			m.tcParentKey, m.tuKey, ;
			m.tcChildTable, 0, m.tcChildKey, m.tuKey)
	endif _tally > 0
endif
return

* Restrict update function: see if there are any records in the specified child
* table matching the specified key in the parent table.

function Restrict_Update(tcParentTable, ;
	tcChildTable, ;
	tcParentKey, ;
	tcChildKey, ;
	tuOldKey, ;
	tuNewKey, tcTag)
local lcTable

if not isnull(m.tuOldKey)
	lcTable = strtran(m.tcChildTable, ' ', '_')

	if not used(m.lcTable)
		use (m.tcChildTable) again in 0 shared alias (m.lcTable)
	endif not used(lcTable)

	if indexseek(m.tuOldKey, .f., m.lcTable, m.tcTag) && Record exists
*	if keymatch(m.tuOldKey,tagno(m.tcTag, '', m.lcTable), m.lcTable) && Record exists
		plError = .t.
		LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict Update', ;
			m.tcParentTable, iif(used(m.tcParentTable),recno(m.tcParentTable),0), ;
			m.tcParentKey, m.tuNewKey, ;
			m.tcChildTable, 0, m.tcChildKey, m.tuOldKey)
	endif _tally > 0
endif
return

* Restrict insert function: ensure a record in the parent table for the foreign
* key exists.
* CFK - 5/28
* Or if the foreign key is null, no parent record is needed.
* The logic is this:
*  if you specify in the dbc that a child cannot exist with out a parent,
*    you can laxly enforce that by allowing nulls in that feild
*    and this code will allow that setting to be overridden
*    by setting the foreign key to null
*  or,
*  you can strictly enforce it by not allowing nulls, and then it will
*    pass this test, but fail the "allow nulls" test that the
*    database engine enforces.

function Restrict_Insert(tcParentTable, ;
	tcChildTable, ;
	tcParentKey, ;
	tcChildKey, ;
	tuKey, ;
	tcTriggerType, tcTag)

local lcTable

* CFK - 5/28
* If the key is Null, don't check for a parent, let it pass.
if !isnull( m.tuKey )

	lcTable = strtran(m.tcParentTable, ' ', '_')

	if not used(m.lcTable)
		use (m.tcParentTable) again in 0 shared alias (m.lcTable)
	endif not used(lcTable)

	if not indexseek(m.tuKey,.f.,m.lcTable,m.tcTag)
*	if not keymatch(m.tuKey,tagno(m.tcTag, '', m.lcTable), m.lcTable) && Record doesn't exist
		plError = .t.
		LogRIError(cnERR_TRIGGER_FAILED, 'Trigger Failed', 'Restrict ' + ;
			proper(m.tcTriggerType), m.tcParentTable, 0, m.tcParentKey, 'Not Found', ;
			m.tcChildTable, iif(used(m.tcChildTable),recno(m.tcChildTable),0), ;
			m.tcChildKey, m.tuKey)
	endif laCount[1] = 0
endif  !isnull( tuKey )

return

* Log errors to the public gaError array.
procedure LogRIError(tnErrNo, ;
	tcMessage, ;
	tcCode, ;
	tcParentTable, ;
	tnParentRec, ;
	tcParentExp, ;
	tuParentKey, ;
	tcChildTable, ;
	tnChildRec, ;
	tcChildExp, ;
	tuChildKey)
local lnErrorRows, ;
	lnLevel

plError = .t.
* Add another row to the error array if necessary.

lnErrorRows = alen(gaErrors, 1)
if type('gaErrors[lnErrorRows, 1]') <> 'L'
	lnErrorRows = lnErrorRows + 1
	dimension gaErrors[lnErrorRows, alen(gaErrors, 2)]
endif type('gaErrors[lnErrorRows, 1]') <> 'L'

* Log the error information, including the parameters passed to us and the
* program stack.

gaErrors[lnErrorRows,  1] = tnErrNo
gaErrors[lnErrorRows,  2] = tcMessage
gaErrors[lnErrorRows,  3] = evl(tcCode,"")
gaErrors[lnErrorRows,  4] = ''
for lnLevel = 1 to program(-1)
	gaErrors[lnErrorRows,  4] = gaErrors[lnErrorRows, 4] + ',' + ;
		program(lnLevel)
next lnLevel
gaErrors[lnErrorRows,  5] = evl(tcParentTable,"")
gaErrors[lnErrorRows,  6] = evl(tnParentRec,0)
gaErrors[lnErrorRows,  7] = evl(tuParentKey,"")
gaErrors[lnErrorRows,  8] = evl(tcParentExp,"")
gaErrors[lnErrorRows,  9] = evl(tcChildTable,"")
gaErrors[lnErrorRows, 10] = evl(tnChildRec,0)
gaErrors[lnErrorRows, 11] = evl(tuChildKey,"")
gaErrors[lnErrorRows, 12] = evl(tcChildExp,"")
return tnErrNo

**__RI_FOOTER!@ Do NOT REMOVE or MODIFY this line!!!! @!__RI_FOOTER**

>>>>It is actually becoming more and more interesting. I made bunch of other changes to fix bugs in cascading deletes/updates. Now I hope it works correctly...
>>>
>>>Hope for you too ;-)
>>>
>>>You'll have to test all scenario's though to be sure.
>>
>>I tested a couple, but I'm now trying to understand, how it should work.
>>
>>If we have a cascaded update, what should be our logic for our table as a child? So far I put a condition, that we check for our table as a child only in it is a first level of trigger execution, e.g. if our trigger was called as a result of cascading update on a parent, I do not run the second SCAN. However, I'm not 100% certain I'm correct.
>>
>>Can somebody with the good understanding of how triggers should behave explain to me all possible scenarios?
>>
>>Thanks in advance.
>
>The trigger level is imo irrelevant here
>
>if there is a cascaded update, the child update fires
>
>The child would normally check if there's a parent with that key.
>
>Doing this will give an illegal recursion. It's also not necessary to test this, if we trust the code of the parent
>
>There's a simple test: do not check any relations with the table one level above, in case of a cascade
>
>Suppose you keep an array, say CascadeInitiator[]
>Each time a trigger fires
>

>dime __t__CascadeInitiator[_triggerlevel]
>__t__CascadeInitiator[_triggerlevel] = ''
>

>
>if you are doing a cascaded update
>

>__t__CascadeInitiator[_TriggerLevel] = m.thistable
>replace .....
>

>
>All relations with __t__CascadeInitiator[_TriggerLevel - 1] should not be tested (error 1887)
>
>think that's about it
>
>To be sure. Use standard RI, set up a cascade delete and a cascade update. Generate the code and look at it