Add handler for notifications and add metrics as one implement of it

src/Soil-Core-Tests/SoilTest.class.st

@@ -143,6 +143,18 @@ SoilTest >> testInitializeDatabaseFailsIfExisting [
 		raise: Error
 ]
 
+{ #category : #tests }
+SoilTest >> testMetrics [
+	| tx metrics |
+	soil notificationHandler: SoilMetrics new.
+	tx := soil newTransaction.
+	tx root: self simpleGraph.
+	tx commit.
+	metrics := soil notificationHandler.
+	self assert: metrics transactionsCreated equals: 1.
+	self assert: metrics transactionsCommittedWrite equals: 1
+]
+
 { #category : #tests }
 SoilTest >> testSerializingClassDescription [
 	| obj bytes obj2 stream transaction |

src/Soil-Core/Soil.class.st

@@ -7,7 +7,8 @@ Class {
 		'behaviorRegistry',
 		'semaphore',
 		'settings',
-		'journal'
+		'journal',
+		'notificationHandler'
 	],
 	#category : #'Soil-Core-Model'
 }
@@ -129,7 +130,9 @@ Soil >> initializeFilesystem [
 	journal := SoilJournal new
 		soil: self;
 		initializeFilesystem;
-		yourself
+		yourself.
+	notificationHandler := SoilNotificationHandler new
+		soil: self
 ]
 
 { #category : #inspector }
@@ -188,11 +191,25 @@ Soil >> newTransaction [
 
 { #category : #transactions }
 Soil >> newTransaction: aClass [
-	^ aClass new 
+	| txn |
+	txn := aClass new 
 		soil: self;
 		readVersion: self databaseVersion;
 		start;
-		yourself
+		yourself.
+	notificationHandler transactionCreated: txn.
+	^ txn
+]
+
+{ #category : #accessing }
+Soil >> notificationHandler [ 
+	^ notificationHandler
+]
+
+{ #category : #accessing }
+Soil >> notificationHandler: anObject [
+
+	^ notificationHandler := anObject
 ]
 
 { #category : #accessing }
@@ -217,8 +234,9 @@ Soil >> open [
 	journal := SoilJournal new
 		soil: self;
 		open;
-		yourself
-
+		yourself.
+	notificationHandler := SoilNotificationHandler new
+		soil: self
 
 ]
 

src/Soil-Core/SoilMetrics.class.st

@@ -0,0 +1,111 @@
+Class {
+	#name : #SoilMetrics,
+	#superclass : #SoilNotificationHandler,
+	#instVars : [
+		'transactionsCreated',
+		'objectsSerialized',
+		'clustersWritten',
+		'clustersRead',
+		'objectsMaterialized',
+		'transactionsCommittedReadOnly',
+		'transactionsCommittedWrite',
+		'transactionsAborted'
+	],
+	#category : #'Soil-Core-Model'
+}
+
+{ #category : #counting }
+SoilMetrics >> clusterRead: aSoilPersistentClusterVersion [ 
+	clustersRead := clustersRead + 1
+]
+
+{ #category : #counting }
+SoilMetrics >> clusterWritten: aCollection [ 
+	clustersWritten := clustersWritten + 1
+]
+
+{ #category : #accessing }
+SoilMetrics >> clustersRead [
+
+	^ clustersRead
+]
+
+{ #category : #accessing }
+SoilMetrics >> clustersWritten [
+
+	^ clustersWritten
+]
+
+{ #category : #initialization }
+SoilMetrics >> initialize [ 
+	super initialize.
+	transactionsCreated := 0.
+	transactionsCommittedReadOnly := 0.
+	transactionsCommittedWrite := 0.
+	transactionsAborted := 0.
+	clustersRead := 0.
+	clustersWritten := 0.
+	objectsSerialized := 0.
+	objectsMaterialized := 0
+]
+
+{ #category : #counting }
+SoilMetrics >> objectMaterialized: aSoilBehaviorDescription [ 
+	objectsMaterialized := objectsMaterialized + 1
+]
+
+{ #category : #counting }
+SoilMetrics >> objectSerialized: aString [ 
+	objectsSerialized := objectsSerialized + 1
+]
+
+{ #category : #accessing }
+SoilMetrics >> objectsMaterialized [
+
+	^ objectsMaterialized
+]
+
+{ #category : #accessing }
+SoilMetrics >> objectsSerialized [
+
+	^ objectsSerialized
+]
+
+{ #category : #counting }
+SoilMetrics >> transactionCommitted: aSoilTransaction [ 
+	aSoilTransaction hasModifications 
+		ifTrue: [ transactionsCommittedWrite := transactionsCommittedWrite + 1 ]
+		ifFalse: [ transactionsCommittedReadOnly := transactionsCommittedReadOnly + 1 ]
+]
+
+{ #category : #'as yet unclassified' }
+SoilMetrics >> transactionCommittedWrite [
+	self shouldBeImplemented.
+]
+
+{ #category : #'as yet unclassified' }
+SoilMetrics >> transactionCreated: aSoilTransaction [ 
+	transactionsCreated := transactionsCreated + 1
+]
+
+{ #category : #accessing }
+SoilMetrics >> transactionsAborted [
+
+	^ transactionsAborted
+]
+
+{ #category : #accessing }
+SoilMetrics >> transactionsCommittedReadOnly [
+
+	^ transactionsCommittedReadOnly
+]
+
+{ #category : #accessing }
+SoilMetrics >> transactionsCommittedWrite [
+	^ transactionsCommittedWrite
+]
+
+{ #category : #accessing }
+SoilMetrics >> transactionsCreated [
+	^ transactionsCreated
+]

src/Soil-Core/SoilNotificationHandler.class.st

@@ -0,0 +1,44 @@
+Class {
+	#name : #SoilNotificationHandler,
+	#superclass : #Object,
+	#instVars : [
+		'soil'
+	],
+	#category : #'Soil-Core-Model'
+}
+
+{ #category : #counting }
+SoilNotificationHandler >> clusterRead: aSoilCluster [
+]
+
+{ #category : #counting }
+SoilNotificationHandler >> clusterWritten: aSoilCluster [
+
+]
+
+{ #category : #counting }
+SoilNotificationHandler >> objectMaterialized: aSoilBehaviorDescription [
+]
+
+{ #category : #counting }
+SoilNotificationHandler >> objectSerialized: anObject [ 
+
+]
+
+{ #category : #accessing }
+SoilNotificationHandler >> soil: anObject [
+
+	soil := anObject
+]
+
+{ #category : #events }
+SoilNotificationHandler >> transactionAborted: aSoilTransaction [
+]
+
+{ #category : #counting }
+SoilNotificationHandler >> transactionCommitted: aSoilTransaction [ 
+]
+
+{ #category : #'as yet unclassified' }
+SoilNotificationHandler >> transactionCreated: aSoilTransaction [
+]

src/Soil-Core/SoilObjectSegment.class.st

@@ -3,7 +3,6 @@ Class {
 	#superclass : #Object,
 	#instVars : [
 		'id',
-		'soil',
 		'objectRepository',
 		'indexFile',
 		'objectFile',
@@ -52,7 +51,9 @@ SoilObjectSegment >> at: anInteger [
 	| position |
 	position := indexFile positionAt: anInteger.
 	^ (objectFile atPosition: position) ifNotNil: [ :record | 
-		record objectId: (SoilObjectId segment: id index: anInteger) ]
+		record objectId: (SoilObjectId segment: id index: anInteger).
+		self soil notificationHandler clusterRead: record.
+		record ]
 ]
 
 { #category : #accessing }
@@ -61,6 +62,8 @@ SoilObjectSegment >> at: anInteger putBytes: bytes [
 	position := objectFile size.
 	objectFile appendBytes: bytes.
 	indexFile at: anInteger putPosition: position.
+	objectRepository ifNotNil: [  
+		objectRepository soil notificationHandler clusterWritten: bytes ].
 	^ position
 ]
 
@@ -236,11 +239,6 @@ SoilObjectSegment >> soil [
 	^ objectRepository soil
 ]
 
-{ #category : #accessing }
-SoilObjectSegment >> soil: aSoil [ 
-	soil := aSoil
-]
-
 { #category : #validating }
 SoilObjectSegment >> validateLastObjectIndex: anInteger [ 
 	indexFile validateLastObjectIndex: anInteger

src/Soil-Core/SoilTransaction.class.st

@@ -20,11 +20,10 @@ Class {
 
 { #category : #aborting }
 SoilTransaction >> abort [
-	recordsToCommit := nil.
-	behaviorDescriptions := nil.
-	soil := nil.
-	idMap := nil.
-	objectMap := nil
+	soil ifNotNil: [  
+		soil notificationHandler transactionAborted: self ].
+	self basicAbort.
+
 ]
 
 { #category : #accessing }
@@ -68,6 +67,15 @@ SoilTransaction >> atObjectId: objectId putObject: anObject [
 	recordsToCommit ifNotNil: [ recordsToCommit add: record ]
 ]
 
+{ #category : #aborting }
+SoilTransaction >> basicAbort [
+	recordsToCommit := nil.
+	behaviorDescriptions := nil.
+	soil := nil.
+	idMap := nil.
+	objectMap := nil
+]
+
 { #category : #public }
 SoilTransaction >> behaviorDescriptionFor: aClass [
 	| behaviorDescription objectId |
@@ -190,7 +198,9 @@ SoilTransaction >> checkpoint [
 	self prepareRecordsForCommit.
 	"if there are no records to commit we can just return and don't allocate any
 	resources"
-	recordsToCommit isEmpty ifTrue: [ ^ self ].
+	recordsToCommit isEmpty ifTrue: [ 
+		soil notificationHandler transactionCommitted: self.
+		^ self ].
 	"only one transactions is allowed at a time. We use the critical block of the database
 	to avoid parallel committing"
 	soil critical: [ 
@@ -218,7 +228,8 @@ SoilTransaction >> checkpoint [
 		"add the journal to the database wide journal so other transaction can access
 		it to resolve older state"
 		soil journal addTransactionJournal: journal ]
-				ensure: [self releaseLocks ] ]
+				ensure: [self releaseLocks ] ].
+		soil notificationHandler transactionCommitted: self
 
 ]
 
@@ -233,7 +244,7 @@ SoilTransaction >> checkpointAndContinue [
 SoilTransaction >> commit [
 	self 
 		checkpoint;
-		abort
+		basicAbort
 ]
 
 { #category : #actions }

src/Soil-Serializer/SoilMaterializer.class.st

@@ -217,6 +217,8 @@ SoilMaterializer >> nextSoilObject [
 
 { #category : #registry }
 SoilMaterializer >> registerObject: anObject [
+	soil ifNotNil: [  
+		soil notificationHandler objectMaterialized: anObject ].
 	objects add: anObject 
 ]
 

src/Soil-Serializer/SoilSerializer.class.st

@@ -191,6 +191,8 @@ SoilSerializer >> registerObject: anObject ifAbsent: aBlock [
 			self nextPutExternalReference: externalIndex ]
 		ifFalse: [
 			objectIdTable add: anObject.
+			soil ifNotNil: [  
+				soil notificationHandler objectSerialized: anObject ].
 			aBlock value ]
 ]