Nadya,
Did you forget this correction message#
1001604 >>Would TRANSACTIONS be overkill ?
>If I press ESC, I end up with unclosed transaction and other problems. E.g. all the commands which should restore environment are not happening automatically.
>
>Here is the trigger's code, put it in some test table and run a long replacement (say, replace next 10000 field1 with ""). Then press ESC and answer Yes On interrupted dialog.
>
>
>**__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.:
>
>* 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
>endif
>
>local lcTable, ;
> lcAlias, ;
> lcRecordState, ;
> lcTriggerType, ;
> laUsed[1], ;
> lcExact, ;
> lcANSI, ;
> lcDeleted, ;
> lcError, ;
> lcOldDBC, ;
> lcDBC, ;
> laRelations[1], ;
> lnRelations, ;
> lcRIInfo, ;
> lcParent, ;
> lcChild, ;
> lcParentKeyExp, ;
> lcChildKeyExp, ;
> luOldKey, ;
> luNewKey, ;
> luOldFK, ;
> luNewFK, ;
> laTables[1], ;
> lnTables
>
>* Define some constants that'll make the code easier to read.
>
>#define cnCHILDCOL 1
>* The column in the relations array for the child table
>#define cnPARENTCOL 2
>* The column in the relations array for the parent table
>#define cnCHILDKEYCOL 3
>* The column in the relations array for the child tag
>#define cnPARENTKEYCOL 4
>* The column in the relations array for the parent tag
>#define cnRIINFOCOL 5
>* The column in the relations array for the RI information
>#define cnRIINFO_UPDATE 1
>* The position in the RI information for the update rule
>#define cnRIINFO_DELETE 2
>* The position in the RI information for the delete rule
>#define cnRIINFO_INSERT 3
>* The position in the RI information for the insert rule
>#define ccFLDSTATE_UNCHANGED '1'
>* GETFLDSTATE() 1 = the field is unchanged
>#define ccFLDSTATE_EDITDEL '2'
>* GETFLDSTATE() 2 = the record was edited or deletion status changed
>#define ccFLDSTATE_NEWUNCHANGED '3'
>* GETFLDSTATE() 3 = a new unchanged field or new undeleted record
>#define ccFLDSTATE_NEWCHANGED '4'
>* GETFLDSTATE() 3 = a new changed field or new deleted record
>#define cnERR_TRIGGER_FAILED 1539
>* Trigger failed error number
>
>* 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)
>
>do case
>
>* If the trigger was passed, use it.
>
>case vartype(m.tcTriggerType) = 'C' and not empty(m.tcTriggerType)
> lcTriggerType = upper(m.tcTriggerType)
>
>* If the deletion status was changed and the record is deleted, this is a
>* "DELETE" trigger.
>
>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
>
>
>* 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.
>
>if _triggerlevel = 1
> begin transaction
> private plError
> plError = .f.
> release gaErrors
> public gaErrors[1, 12]
> aused(laUsed)
> lcExact = set('EXACT')
> lcANSI = set('ANSI')
> lcDeleted = set('DELETED')
> lcError = on('ERROR')
> set exact on
> set ansi on
> set deleted on
> on error LogRIError(error(),message())
>endif
>
>if vartype(m.plError) = "L" and m.plError
>** Error occurred
>else
>* Select the database the table belongs to and get an array of relations.
>
> lcOldDBC = iif(empty(dbc()), '', '"' + dbc() + '"')
> lcDBC = cursorgetprop('Database')
> set database to (m.lcDBC)
> lnRelations = adbobjects(laRelations, 'RELATION')
>
> local lnTParent, lnTChild, lnI, lcChildTag, lcParentTag
> store 0 to lnTParent, lnTChild
> store "" to lcParentKeyExp, lcChildKeyExp
>
>** First search in the parent column
> lnTParent = ascan(laRelations, m.lcTable, m.lnTParent + 1, ;
> m.lnRelations , cnPARENTCOL, 8)
>
> do while between(m.lnTParent,1,m.lnRelations) and not m.plError
> lnI = m.lnTParent
>
> lcParent = laRelations[m.lnI, cnPARENTCOL]
> lcChild = laRelations[m.lnI, cnCHILDCOL]
> lcRules = upper(laRelations[m.lnI, cnRIINFOCOL])
>
> lcParentTag = laRelations[m.lnI, cnPARENTKEYCOL]
>
> lcChildTag = laRelations[m.lnI, cnCHILDKEYCOL]
>
> 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' and m.lcParent = m.lcTable
> lcRIInfo = substr(m.lcRules, cnRIINFO_UPDATE, 1)
> if not empty(m.lcRIInfo) and m.lcRIInfo <> 'I'
> lcParentKeyExp = key(tagno(laRelations[m.lnI, cnPARENTKEYCOL], ;
> '', m.lcAlias), m.lcAlias)
> lcChildKeyExp = GetKeyIndexExp(m.lcChild, ;
> laRelations[m.lnI, cnCHILDKEYCOL])
> luOldKey = oldval(m.lcParentKeyExp)
> luNewKey = evaluate(m.lcParentKeyExp)
>
>* 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
> luOldFK = oldval(m.lcChildKeyExp)
> luNewFK = evaluate(m.lcChildKeyExp)
> 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' and m.lcParent == m.lcTable
> lcRIInfo = substr(m.lcRules, cnRIINFO_DELETE, 1)
> if not empty(m.lcRIInfo) and m.lcRIInfo <> 'I'
> lcParentKeyExp = key(tagno(laRelations[m.lnI, cnPARENTKEYCOL], ;
> '', m.lcAlias), m.lcAlias)
> lcChildKeyExp = GetKeyIndexExp(m.lcChild, ;
> laRelations[m.lnI, cnCHILDKEYCOL])
> luKey = evaluate(m.lcParentKeyExp)
>
>* 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.luKey)
> case m.lcRIInfo = 'R'
> Restrict_Delete(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
> m.lcChildKeyExp, m.luKey, m.lcChildTag)
> endcase
> endif not empty(lcRIInfo) ...
> endcase
>
> lnTParent = ascan(laRelations, m.lcTable, m.lnI + 1, ;
> m.lnRelations - m.lnI, cnPARENTCOL, 8)
> enddo
>
>** Now do the same for the child column
> lnTChild = ascan(laRelations, m.lcTable, m.lnTChild + 1, m.lnRelations , cnCHILDCOL, 8)
>
> do while m.lnTChild > 0 and not m.plError
> lnI = m.lnTChild
> lcParent = laRelations[m.lnI, cnPARENTCOL]
> lcChild = laRelations[m.lnI, cnCHILDCOL]
> lcRules = upper(laRelations[m.lnI, cnRIINFOCOL])
>
> lcParentTag = laRelations[m.lnI, cnPARENTKEYCOL]
>
> lcChildTag = laRelations[m.lnI, cnCHILDKEYCOL]
>
>* 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.
>
>*case lcChild = lcTable
> lcRIInfo = substr(m.lcRules, cnRIINFO_INSERT, 1)
> if m.lcRIInfo = 'R'
> lcParentKeyExp = GetKeyIndexExp(m.lcParent, ;
> laRelations[m.lnI, cnPARENTKEYCOL])
> lcChildKeyExp = key(tagno(laRelations[m.lnI, cnCHILDKEYCOL], ;
> '', m.lcAlias), m.lcAlias)
> luKey = evaluate(m.lcChildKeyExp)
>
>* 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 <> 'UPDATE' or oldval(m.lcChildKeyExp) <> m.luKey
> Restrict_Insert(m.lcParent, m.lcChild, m.lcParentKeyExp, ;
> m.lcChildKeyExp, m.luKey, m.lcTriggerType, m.lcParentTag)
> endif lcTriggerType <> 'UPDATE' ...
> endif lcRIInfo = 'R'
> lnTChild = ascan(laRelations, m.lcTable, m.lnI + 1, ;
> m.lnRelations - m.lnI, cnCHILDCOL, 8)
> enddo
>
>* 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.
>endif
>if not empty(m.lcOldDBC)
> set database to (m.lcOldDBC)
>endif
>if _triggerlevel = 1
> if m.plError
> rollback
> else
> end transaction
> endif plError
> lnTables = aused(laTables)
> for lnI = 1 to m.lnTables
> lcTable = laTables[m.lnI, 1]
> if not empty(m.lcTable) and ascan(laUsed, m.lcTable) = 0
> use in (m.lcTable)
> endif not empty(lcTable) ...
> next lnI
> if m.lcExact = "OFF"
> set exact off
> endif
> if m.lcANSI = "OFF"
> set ansi off
> endif
> if m.lcDeleted = "OFF"
> set deleted off
> endif
> on error &lcError
>
>* If we're not at the top trigger level, return .T. so we don't trigger an
>* error yet.
>else
>
>endif _triggerlevel = 1
>return not m.plError
>
>* Determine the key expression for the specified tag.
>
>function GetKeyIndexExp(tcTable, ;
> tcTag)
>local lcTable, ;
> lcIndexExp
>lcTable = strtran(m.tcTable, ' ', '_')
>if not used(m.lcTable)
> use (m.tcTable) again in 0 shared alias (m.lcTable)
>endif not used(lcTable)
>lcIndexExp = key(tagno(m.tcTag, '', m.lcTable), m.lcTable)
>return m.lcIndexExp
>
>* 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]
>
>* Do the cascading update. Log any error that occurred.
>if isnull(m.tuOldKey )
> update (m.tcChildTable) ;
> set &tcChildKey = m.tuNewKey ;
> where &tcChildKey is null
>else
> 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 isnull(m.tuOldKey)
> delete ;
> from (m.tcChildTable) ;
> where &tcChildKey is null
>else
> 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 laCount[1]
>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)
>*!* select count(*), ;
>*!* recno() ;
>*!* from (tcChildTable) ;
>*!* where &tcChildKey = tuKey ;
>*!* into array laCount
>*!* if _tally > 0
> 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 laCount[1]
>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)
>
>*!* select count(*), ;
>*!* recno() ;
>*!* from (tcChildTable) ;
>*!* where &tcChildKey = tuOldKey ;
>*!* into array laCount
>*!* if _tally > 0
>
> 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 forign 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 laCount[1]
>local lcTable
>
>* CFK - 5/28
>* If the key is Null, don't check for a parent, let it pass.
>if !isnull( m.tuKey )
>
>* If no rows in the parent table match the foreign key, SELECT COUNT(*) will
>* always return one row, so _TALLY = 1; SELECT COUNT(*), (more fields) will not
>* return a row. Therefore, we need to check laCount[1] rather than _TALLY.
>
>*!* select count(*) ;
>*!* from (tcParentTable) ;
>*!* where &tcParentKey = tuKey ;
>*!* into array laCount
>*!* if laCount[1] = 0
> 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)
> 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**
>
Gregory
