625ee6ac59a9 — Gerald Klix (speedy) 2 months ago
SUM: (Nested) transactions and blocks.
2 files changed, 86 insertions(+), 9 deletions(-)

M haver/db/PlanE.pck.st
M haver/transactions/Transactions.pck.st
M haver/db/PlanE.pck.st +27 -5
@@ 1,8 1,8 @@ 
-'From Haver 6.0 [latest update: #5092] on 9 March 2022 at 9:50:37 pm'!
+'From Haver 6.0 [latest update: #5366] on 9 July 2022 at 1:08:16 pm'!
 'Description Yet another try on some means of peristence.'!
-!provides: 'PlanE' 1 47!
+!provides: 'PlanE' 1 48!
 !requires: 'Cuis-Base' 50 4594 nil!
-!requires: 'Transactions' 1 26 nil!
+!requires: 'Transactions' 1 27 nil!
 !requires: 'Collections-TwoAndEightByteArrays' 1 1 nil!
 SystemOrganization addCategory: 'PlanE'!
 SystemOrganization addCategory: 'PlanE-Records'!

          
@@ 14,8 14,8 @@ Modules newEnvironment: #PlanE!
 
 !interfacesOf: PlanE!
 Modules environment: #PlanE ::
-	interface: #SPI exporting: #(#DoubleWordArrayRecord #AbstractMetaRecord #AbstractAtomicRecord #CompiledMethodProxy #ObjectRecord #AbstractProxy #LargeNegativeIntegerRecord #PositiveSmallIntegerRecord #FileStore #DoubleByteArrayRecord #StringRecord #RootsRecord #ModuleProxy #AbstractAtomicCollectionRecord #UninternedSymbolRecord #SetRecord #ByteArrayRecord #InternedSymbolRecord #TransactionManager #DictionaryRecord #AbstractLargeIntegerRecord #AbstractSmallIntegerRecord #Transaction #WordArrayRecord #AbstractStringLike #LargePositiveIntegerRecord #StoreRecord #AbstractSetRecord #PlanE #AbstractRecord #EnvironmentProxy #NegativeSmallIntegerRecord #AbstractStatelessProxy #AbstractClassRecord #CodePackageProxy #PlanEClassRecord #PersistentObject #LocalSymbolProxy #SmalltalkProxy #BaseClassRecord #ClassRecord #AbstractInstanceRecord ) ::
-	interface: #UTI exporting: #(#DoubleWordArrayRecord #AbstractMetaRecord #AbstractAtomicRecord #CompiledMethodProxy #ObjectRecord #AbstractProxy #LargeNegativeIntegerRecord #PositiveSmallIntegerRecord #FileStore #DoubleByteArrayRecord #StringRecord #RootsRecord #ModuleProxy #AbstractAtomicCollectionRecord #UninternedSymbolRecord #SetRecord #ByteArrayRecord #InternedSymbolRecord #TransactionManager #DictionaryRecord #AbstractLargeIntegerRecord #AbstractSmallIntegerRecord #Transaction #WordArrayRecord #AbstractStringLike #LargePositiveIntegerRecord #StoreRecord #AbstractSetRecord #PlanE #AbstractRecord #EnvironmentProxy #RunningWorldProxy #NegativeSmallIntegerRecord #AbstractStatelessProxy #AbstractClassRecord #CodePackageProxy #PlanEClassRecord #PersistentObject #LocalSymbolProxy #SmalltalkProxy #BaseClassRecord #ClassRecord #AbstractInstanceRecord ) ::
+	interface: #SPI exporting: #(#AbstractStringLike #PlanEClassRecord #NegativeSmallIntegerRecord #StringRecord #AbstractSmallIntegerRecord #AbstractMetaRecord #Transaction #PlanE #CodePackageProxy #ClassRecord #InternedSymbolRecord #AbstractInstanceRecord #DoubleWordArrayRecord #PersistentObject #LocalSymbolProxy #PositiveSmallIntegerRecord #AbstractAtomicCollectionRecord #LargePositiveIntegerRecord #StoreRecord #LargeNegativeIntegerRecord #AbstractStatelessProxy #ByteArrayRecord #FileStore #TransactionManager #AbstractProxy #AbstractClassRecord #AbstractRecord #SetRecord #DictionaryRecord #BaseClassRecord #UninternedSymbolRecord #WordArrayRecord #AbstractAtomicRecord #CompiledMethodProxy #ModuleProxy #DoubleByteArrayRecord #RootsRecord #ObjectRecord #AbstractLargeIntegerRecord #AbstractSetRecord #EnvironmentProxy #SmalltalkProxy ) ::
+	interface: #UTI exporting: #(#AbstractStringLike #PlanEClassRecord #NegativeSmallIntegerRecord #StringRecord #AbstractSmallIntegerRecord #AbstractMetaRecord #Transaction #PlanE #CodePackageProxy #ClassRecord #InternedSymbolRecord #AbstractInstanceRecord #DoubleWordArrayRecord #PersistentObject #LocalSymbolProxy #PositiveSmallIntegerRecord #AbstractAtomicCollectionRecord #LargePositiveIntegerRecord #StoreRecord #LargeNegativeIntegerRecord #AbstractStatelessProxy #ByteArrayRecord #RunningWorldProxy #FileStore #TransactionManager #AbstractProxy #AbstractClassRecord #AbstractRecord #SetRecord #DictionaryRecord #BaseClassRecord #UninternedSymbolRecord #WordArrayRecord #AbstractAtomicRecord #CompiledMethodProxy #ModuleProxy #DoubleByteArrayRecord #RootsRecord #ObjectRecord #AbstractLargeIntegerRecord #AbstractSetRecord #EnvironmentProxy #SmalltalkProxy ) ::
 	interface: #Store exporting: #(#(#Store #FileStore) ) ::
 	interface: #API exporting: #(#PlanE )!
 

          
@@ 1436,6 1436,28 @@ register: anObject
 
 	^ transactionManager register: anObject! !
 
+!(Modules>>#PlanE>>#PlanE) methodsFor: 'transactions' stamp: 'KLG 7/9/2022 12:33:27'!
+transact: aBlock
+	"Evaluate a block in a transaction
+	
+	Commit the transaction after that, if an exception occurs abort the transaction.
+	
+	Do not support nested transactions."
+	
+	^ transactionManager transact: aBlock 
+! !
+
+!(Modules>>#PlanE>>#PlanE) methodsFor: 'transactions' stamp: 'KLG 7/9/2022 12:32:45'!
+transactNested: aBlock
+	"Evaluate a block in a transaction
+	
+	Commit the transaction after that, if an exception occurs abort the transaction.
+	
+	Support nested transactions."
+	
+	^ transactionManager transactNested: aBlock 
+! !
+
 !(Modules>>#PlanE>>#PlanE) class methodsFor: 'instance creation' stamp: 'KLG 5/21/2021 10:42:42'!
 fileStoreClass
 	"Answer the file store class to use."

          
M haver/transactions/Transactions.pck.st +59 -4
@@ 1,6 1,6 @@ 
-'From Haver 6.0 [latest update: #5092] on 9 March 2022 at 9:50:03 pm'!
+'From Haver 6.0 [latest update: #5366] on 9 July 2022 at 1:08:02 pm'!
 'Description In memory or in-image transactions.'!
-!provides: 'Transactions' 1 26!
+!provides: 'Transactions' 1 27!
 !requires: 'WriteBarrier' 1 23 nil!
 SystemOrganization addCategory: 'Transactions'!
 

          
@@ 10,9 10,9 @@ Modules newEnvironment: #Transactions!
 
 !interfacesOf: Transactions!
 Modules environment: #Transactions ::
-	interface: #SPI exporting: #(#TransactiveObject #TransactionManager #Transaction #ObjectTracker #TransactionLeader ) ::
+	interface: #SPI exporting: #(#TransactionLeader #TransactionManager #TransactiveObject #Transaction #ObjectTracker ) ::
 	interface: #UTI exporting: #(#ModificationForbiddenHandler ) ::
-	interface: #API exporting: #(#TransactiveObject #TransactionManager #TransactionLeader )!
+	interface: #API exporting: #(#TransactionLeader #TransactionManager #TransactiveObject )!
 
 
 !classDefinition: (Modules>>#Transactions>>#ModificationForbiddenHandler) category: 'Transactions'!

          
@@ 282,6 282,19 @@ begin
 		involvedObject beReadOnlyObjectIfSensible ]
 	! !
 
+!(Modules>>#Transactions>>#Transaction) methodsFor: 'transactions' stamp: 'KLG 7/9/2022 10:11:17'!
+beginIfNotActive
+	"Mark the begin of a transaction, if the transaction is new, answer true.
+	
+	If it is active do nothing and answer false"
+
+	state == #active
+		ifTrue: [ ^ false ]
+		ifFalse: [
+			self begin.
+			^ true ]
+	! !
+
 !(Modules>>#Transactions>>#Transaction) methodsFor: 'transactions' stamp: 'KLG 2/25/2022 11:26:32'!
 commit
 	"Commit this transaction (me)."

          
@@ 400,6 413,14 @@ begin: anId
 
 	^ self active id: anId :: begin! !
 
+!(Modules>>#Transactions>>#TransactionManager) methodsFor: 'transactions' stamp: 'KLG 7/9/2022 10:12:15'!
+beginIfNotActive
+	"Mark the begin of a transaction, if the transaction is new, answer true.
+	
+	If it is active do nothing and answer false"
+
+	^ self active beginIfNotActive! !
+
 !(Modules>>#Transactions>>#TransactionManager) methodsFor: 'transactions' stamp: 'KLG 1/31/2019 19:11:08'!
 commit
 	"Commit the current transaction."

          
@@ 441,6 462,40 @@ register: anObject
 	super register: anObject.
 	^ self active register: anObject; yourself ! !
 
+!(Modules>>#Transactions>>#TransactionManager) methodsFor: 'transactions' stamp: 'KLG 7/9/2022 12:37:10'!
+transact: aBlock
+	"Evaluate a block in a transaction
+	
+	Commit the transaction after that, if an exception occurs abort the transaction.
+	
+	Do not support nested transactions."
+	
+	| answer |
+	self begin.
+	answer _ aBlock ifCurtailed: [
+		self abort.
+		^ nil ].
+	self commit.
+	^ answer! !
+
+!(Modules>>#Transactions>>#TransactionManager) methodsFor: 'transactions' stamp: 'KLG 7/9/2022 12:37:51'!
+transactNested: aBlock
+	"Evaluate a block in a transaction
+	
+	Commit the transaction after that, if an exception occurs abort the transaction.
+	
+	Support nested transactions."
+	
+	| isNewTransaction answer |
+	isNewTransaction _ self beginIfNotActive.
+	answer _ aBlock ifCurtailed: [ 
+		isNewTransaction ifTrue: [
+			self abort.
+			^ nil ] ].
+	isNewTransaction ifTrue: [
+		self commit ].
+	^ answer! !
+
 !(Modules>>#Transactions>>#TransactionManager) methodsFor: 'instance creation' stamp: 'KLG 5/21/2021 16:48:48'!
 newTransaction