Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
VFP 'lockup' woes
Message
From
27/09/2002 10:24:27
 
 
To
27/09/2002 07:32:39
General information
Forum:
Visual FoxPro
Category:
Troubleshooting
Miscellaneous
Thread ID:
00704984
Message ID:
00705222
Views:
14
>>Dana,
>>
>>I have not encountered the problem you are talking about.
>>
>>However, have you considered not to do FLock() at all and updating the table within a transaction.
>>
>>If only part of the table changes, I can provide you with a piece of code that just updates/inserts/deletes the delta on the whole table or on only part of it
>
>
>Gregory,
>
>I welcome the code you mentioned. At this point I am trying to find a different way of updating the table in hope that I can avoid the lock-up.
>
>Thanks
>-Dana

Dana,


This updates a table with a cursor that reflects what the contents of the table should be. No flocks, the whole process is done within a transaction.

I'm using this since a year or so and I have no complaints (yet)

Since it is done within a transaction, huge batches are best run at night. Small subsets (100-1000 records or possibly more depending on the environment) can be done while everyone is busy

I have commented the therm() parts. Insert yours if you like it visual

You will find a couple of asserts. I use them to debug when something goes wrong in my development

Hope I haven't forgotten to include any piece.

Success,
#ifndef	TRUE
	#define TRUE	.T.
	#define	FALSE	.F.
#endif
*---------------------------------------------------------------------------
** Test it
**	use MyTable in 0 

** make a cursor with the same layout as MyTable, eg copy MyTable to a cursor
**	delete a few records from the cursor
**	modify a few record from the cursor
**	add a few records to the cursor

&& ?UpdateTable('MyTable', 'MyCursor', 'Field1+Field2', 'OrderTag')

** use the _Filter when you only want to update part of the table
**	the cursor then only holds part of the table
** eg
**	use MyTable in 0
**	select * ;
		from Mytable where country = 'USA' ;
		into cursor MyCursor
**	select MyCursor
**	delete a few records from the cursor
**	modify a few record from the cursor	(leave country USA)
**	add a few records to the cursor	( with country USA)
&& ?UpdateTable('MyTable', 'MyCursor', 'Field1+Field2', 'OrderTag', [(country = 'USA')])

** NOTE: TableKeyTag must be either Primary or Candidate
*---------------------------------------------------------------------------
procedure	UpdateTable(TableAlias, NewContents, TableKeyExpr, TableKeyTag, _Filter , WithArray)


	local s, Table_recno, Table_Buffering, _key, n, t, NewContents_recno
	local obj_new, obj_table, Success, TableArray[1]
	
	local sTalk, sDeleted, sError
	
	s = select(0)
	Table_recno = recno(TableAlias)
	Table_Buffering = CursorGetProp('Buffering', TableAlias)
	if( Table_Buffering <> DB_BUFOPTRECORD )
		=CursorSetProp('Buffering', DB_BUFOPTRECORD, TableAlias)
	endif
	
	NewContents_recno = recno(NewContents)

	
	sTalk = set('Talk')
	set Talk Off
	sDeleted = Set('Deleted')
	Set Deleted On
	sError = on('Error')
	
	select (TableAlias)
	if( empty(_Filter) )
		_Filter = '.T.'
	endif
	
	local ToDelete, ToDelete_
	ToDelete = NewCursorName()
	ToDelete_ = NewCursorName()
	
	select	recno() as RecToDelete ;
		from (TableAlias) ;
		into cursor (ToDelete_) ;
		where	&_Filter
	
	select (ToDelete_)
	
	=CreateCursorCopy(ToDelete)
	
	use in (ToDelete_)
	select (ToDelete)
	index on bintoc(RecToDelete) tag ToDelete
	
	
	Success = TRUE
	private HadError
	HadError = FALSE
	on Error HadError = TRUE
	*on error suspend
	

	
	Begin Transaction
	select (NewContents)
	
	&& t = therm(Reccount(), 'Obsolete in ' + TableAlias )
	n = 0
	scan all while Success and !HadError
		n = n + 1
		&& =iif( empty(mod(n,20)), t.Update(n), TRUE )
		
		_key = eval(TableKeyExpr)
				
		if( seek(_key, TableAlias, TableKeyTag) )
			if( seek( bintoc(recno(TableAlias)), ToDelete ) )
				delete in (ToDelete)
			else
				assert FALSE
			endif			
		endif
	endscan
	
	Success = Success and !HadError
	
	t = Null
	
	if( Success )
		select (ToDelete)
		
		&& t = therm(RecordCount(), ' Deleting ...' )
		n = 0
		
		if( !IsRunTime() )
			on error
		endif
		
		scan all while Success and !HadError
			n = n + 1
			&& =t.Update(n)
			
			select (TableAlias)
			go (&ToDelete..RecToDelete)
	
			if( (IsRLocked() and !Deleted()) or !RLock() )
				assert FALSE
				Success = FALSE
			else
				delete
				if( !TableUpdate() )
					Success = FALSE
					assert FALSE
				endif
				unlock record (recno())
			endif
			select (ToDelete)
			assert !HadError
		endscan
		t = Null
	endif
	
	Success = Success and !HadError
	select (NewContents)
	&& t = therm(Reccount(), 'Updating ' + TableAlias +  ' with ' + NewContents )
	n = 0
	scan all while Success and !HadError
		
		n = n + 1
		&& =iif( empty(mod(n,20)), t.Update(n), TRUE )
		
		_key = eval(TableKeyExpr)
		scatter memo name obj_new
		if( seek(_key, TableAlias, TableKeyTag) )
			
			select (TableAlias)
			scatter memo name obj_Table
			if( !compobj(obj_New, obj_Table) )
				if( WithArray )
					select (NewContents)
					scatter memo to TableArray
					select (TableAlias)
					gather from TableArray memo
				else
					gather name obj_new memo
				endif
				
				if( !TableUpdate() )
					assert FALSE
					Success = FALSE
				endif
			endif
		else
			if( WithArray )
				scatter memo to TableArray
			endif
			select (TableAlias)
			append blank
			
			if( WithArray )
				gather from TableArray memo
			else
				gather name obj_new memo
			endif
			
			if( !TableUpdate() )
				assert FALSE
				Success = FALSE
			endif
		endif
		
		select (NewContents)
	endscan
	
	Success = Success and !HadError
	
	t = Null
	
	if( Success )
		end Transaction
	else
		rollback
	endif
	
	on Error &sError
	
	use in (ToDelete)
	
	=RestoreRecordNumber(NewContents_recno, NewContents)
	=RestoreRecordNumber(Table_recno, TableAlias)
	if( Table_Buffering <> DB_BUFOPTRECORD )
		=CursorSetProp('Buffering', Table_Buffering, TableAlias)
	endif
	
	set Deleted &sDeleted
	set Talk &sTalk
	
	select (s)
	
	return Success
endproc
*-------------------------------------------------------------------------
procedure	CreateCursorCopy(Cursor, _Filter)
	=CreateCursor(Cursor)
	=CopyAlias(alias(), Cursor, _Filter)	&& from alias()
endproc
*--------------------------------------------------------------------------
procedure	CreateCursor(Cursor)
	local x[1], i, j, s
	=afields(x)
	* Eleminate Field Validation Rules, triggers, and the like
	for i = 1 to alen(x,1)
		for j = 6 to alen(x,2)
			x[i,j] = ''
		endfor
	endfor
	s = select(0)
	if( used(Cursor) )
		use in (Cursor)
	endif
	select 0
	create cursor (Cursor) from array x
	select (s)
endproc
*--------------------------------------------------------------------------
procedure	CopyAlias(AliasFrom, AliasTo, _Filter)

	if( empty(_Filter) )
		_Filter = ''
	else
		_Filter = 'And ' + _Filter
	endif
	local s, sTalk
	sTalk = set('Talk')
	set Talk Off
	s = select(0)
	select	(AliasTo)
	append from dbf(AliasFrom) for !deleted() &_Filter
	select (s)
	set Talk &sTalk
endproc
*--------------------------------------------------------------------------
function	NewCursorName()
	return	sys(2015)
endfunc
*---------------------------------------------------------------------------
procedure	RestoreRecordNumber(r, alias_)
	if( empty(alias_) )
		alias_ = alias()
	endif
	
	local sTalk
	sTalk = set('Talk')
	set Talk Off
	
	if( r <= reccount(alias_) )
		go r in (alias_)
	else	&& eof condi
		go bottom in (alias_)
		if( !eof(alias_) )
			skip in (alias_)
		endif
	endif
	
	set Talk &sTalk
endproc
*---------------------------------------------------------------------------
function IsRunTime()
	return empty(Version(2))
endfunc
*---------------------------------------------------------------------------
Gregory
Previous
Reply
Map
View

Click here to load this message in the networking platform