Copied GraphExporter/-Importer from main

src/Soil-Core/SoilGraphExporter.class.st

@@ -9,11 +9,30 @@ Class {
 		'versionMap',
 		'indexesToSkip',
 		'behaviors',
-		'clusters'
+		'clusters',
+		'replacements',
+		'toBeExported'
 	],
 	#category : #'Soil-Core-Error'
 }
 
+{ #category : #adding }
+SoilGraphExporter >> addObject: anObject [ 
+	self addObjectId: (transaction objectIdOf: anObject)
+]
+
+{ #category : #adding }
+SoilGraphExporter >> addObjectId: aSoilObjectId [ 
+	toBeExported add: aSoilObjectId 
+]
+
+{ #category : #adding }
+SoilGraphExporter >> addObjects: aCollection [ 
+	aCollection do: [ :each |
+		self addObject: each ]
+
+]
+
 { #category : #visiting }
 SoilGraphExporter >> behaviorAt: index [ 
 	^ behaviors 
@@ -23,6 +42,27 @@ SoilGraphExporter >> behaviorAt: index [
 
 ]
 
+{ #category : #actions }
+SoilGraphExporter >> export [
+	"export format: 
+	1. exported objects 
+	A list of arbitrary object clusters to be exported"
+	stream nextPut: toBeExported size. 
+	toBeExported do: [ :oid |
+		oid writeOn: stream .
+		self processObjectId: oid ].
+	"2. non-mapped objects
+	These are objects that will not be serialized but still have 
+	references in clusters to it. This is to prevent exporting all
+	of the graph. The dangeling references need to be re-mapped by
+	the importer"
+	stream nextPut: replacements size.
+	replacements do: [ :oid |
+		oid writeOn: stream ].
+	"Now write out all reachable clusters but not the non-mapped"
+	self processLoop
+]
+
 { #category : #'as yet unclassified' }
 SoilGraphExporter >> export: aSoilObjectId [ 
 	self processObjectId: aSoilObjectId.
@@ -37,6 +77,8 @@ SoilGraphExporter >> initialize [
 	indexesToSkip := OrderedCollection new.
 	behaviors := Dictionary new.
 	clusters := 0.
+	toBeExported := OrderedCollection new.
+	replacements := OrderedCollection new.
 ]
 
 { #category : #visiting }
@@ -51,7 +93,7 @@ SoilGraphExporter >> isUpToDateCluster: aCluster [
 { #category : #'as yet unclassified' }
 SoilGraphExporter >> metaSegment [ 
 	^ metaSegment ifNil: [ 
-		metaSegment := soil objectRepository metaSegment ].
+		metaSegment := transaction soil objectRepository metaSegment ].
 
 ]
 
@@ -60,7 +102,7 @@ SoilGraphExporter >> migrate: aClass to: aBlock [
 	"lookup the objectID of the behavior and store it 
 	along with the block "
 	migrationMap 
-		at: (soil behaviorRegistry 
+		at: (transaction soil behaviorRegistry 
 			nameAt: aClass name 
 			ifAbsent: [Error signal: 'no class found']) index 
 		put: aBlock 
@@ -93,6 +135,17 @@ SoilGraphExporter >> migrateCluster: cluster [
 	^ newCluster
 ]
 
+{ #category : #accessing }
+SoilGraphExporter >> processObjectId: oid [ 
+	(replacements includes: oid) ifTrue: [ ^ self ].
+	super processObjectId: oid 
+]
+
+{ #category : #'as yet unclassified' }
+SoilGraphExporter >> replaceObject: anObject [
+	replacements add: (transaction objectIdOf: anObject)
+]
+
 { #category : #'as yet unclassified' }
 SoilGraphExporter >> skipIndexes: aCollection [ 
 	indexesToSkip := aCollection collect: [ :each |
@@ -114,7 +167,8 @@ SoilGraphExporter >> stream: anObject [
 
 { #category : #accessing }
 SoilGraphExporter >> transaction: aTransaction [ 
-	transaction := aTransaction 
+	transaction := aTransaction.
+	soil := aTransaction soil 
 ]
 
 { #category : #visiting }
@@ -168,6 +222,7 @@ SoilGraphExporter >> visitPersistentClusterVersion: aCluster [
 		serializeOn: stream .
 	"for all indexes being used remember the index setting for it "
 	cluster references do: [ :reference |
+		"(oidsToIgnore includes: reference) ifTrue: [ self halt ]."
 		self processObjectId: reference ].
 	cluster indexIds ifNotEmpty: [ 
 		cluster object ifNil: [  
@@ -176,8 +231,6 @@ SoilGraphExporter >> visitPersistentClusterVersion: aCluster [
 				materializeObject;
 				yourself) ].
 		self visit: cluster object ].
-	stream nextPut: 255.
-
 ]
 
 { #category : #visiting }

src/Soil-Core/SoilGraphImporter.class.st

@@ -6,20 +6,37 @@ Class {
 		'transaction',
 		'lastIndex',
 		'idMap',
-		'newId',
-		'metaSegment'
+		'metaSegment',
+		'clusters',
+		'toBeReplaced',
+		'replacements',
+		'legacyOids'
 	],
 	#category : #'Soil-Core-Error'
 }
 
 { #category : #importing }
 SoilGraphImporter >> import [
+	"set the last indexes of this database. Importing will not use the objectIds that
+	have been exported. This might waste huge amounts of ids. So we remap all objectIds
+	to ids that come right after the current ones."
 	lastIndex := Array new: 2.
 	lastIndex at: 1 put: (transaction objectRepository metaSegment) lastObjectIndex.
 	lastIndex at: 2 put: (transaction objectRepository segmentAt: 1) lastObjectIndex.
-
+	clusters := OrderedCollection new.
+	"read the list of objejctIds to be imported. This gives us access to the objects that
+	will have different objectids after import"
+	legacyOids := Array new: stream next.
+	1 to: legacyOids size do: [ :n |
+		legacyOids at: n put: (SoilObjectId readFrom: stream) ].
+	"read the list of non-mapped objectIds. Before importing we need to register a local 
+	object for all of these objectids so they can be re-mapped."
+	toBeReplaced := Array new: stream next.
+	1 to: toBeReplaced size do: [ :n |
+		toBeReplaced at: n put: (SoilObjectId readFrom: stream) ].
+	"Now just read all clusters til the end and import them into the object repository"
 	[ stream atEnd ] whileFalse: [ 
-		self readCluster ].
+		clusters add: self readCluster ].
 
 	soil objectRepository firstSegment updateLastObjectIndex: (lastIndex at: 2)
 ]
@@ -58,10 +75,21 @@ SoilGraphImporter >> importBehaviorCluster: cluster [
 				putBytes: (cluster asNewClusterVersion version: 1; serialize) ] 
 ]
 
+{ #category : #'instance creation' }
+SoilGraphImporter >> importedObjects [
+	^ self importedOids collect: [ :each | transaction objectWithId: each ]
+]
+
+{ #category : #'instance creation' }
+SoilGraphImporter >> importedOids [
+	^ legacyOids collect: [ :each | self newObjectIdFor: each ]
+]
+
 { #category : #initialization }
 SoilGraphImporter >> initialize [ 
 	super initialize.
-	idMap := Dictionary new
+	idMap := Dictionary new.
+	replacements := OrderedCollection new
 ]
 
 { #category : #importing }
@@ -71,11 +99,6 @@ SoilGraphImporter >> metaSegment [
 
 ]
 
-{ #category : #accessing }
-SoilGraphImporter >> newId [
-	^ newId
-]
-
 { #category : #'instance creation' }
 SoilGraphImporter >> newObjectIdFor: aSoilObjectId [ 
 	| current |
@@ -125,17 +148,19 @@ SoilGraphImporter >> readBehaviorDescription [
 
 { #category : #importing }
 SoilGraphImporter >> readCluster [
-	| objectId cluster keySize valueSize index maxLevel originalOid |
+	| objectId cluster keySize valueSize index maxLevel originalOid serialized |
 	originalOid := SoilObjectId readFrom: stream.
 	objectId := self newObjectIdFor: originalOid.
-	newId ifNil: [newId := objectId ].
 	(stream next: 8) asInteger timesRepeat: [ 
 		 self readBehaviorDescription ].
 	cluster := (SoilPersistentClusterVersion new readFrom: stream)
 		detachFromSegment;
 		objectId: objectId;
 		version: self databaseVersion.
-	cluster references: (cluster references collect: [:id| self newObjectIdFor: id]).
+	cluster references: (cluster references collect: [:id| 
+		(toBeReplaced includes: id) 
+			ifTrue: [ replacements at: (toBeReplaced indexOf: id) ] 
+			ifFalse: [ self newObjectIdFor: id ] ]).
 	cluster indexIds do: [ :indexId |
 		keySize := (stream next: 2) asInteger.
 		valueSize := (stream next: 2) asInteger.
@@ -148,10 +173,16 @@ SoilGraphImporter >> readCluster [
 		index writePages  ].
 	cluster behaviorDescriptions: (cluster behaviorDescriptions collect: [ :bd |
 		 idMap at: bd objectId asSoilObjectId ]).
+	serialized := cluster serialize.
 	soil objectRepository 
 		at: cluster objectId 
-		putBytes: cluster serialize.
-	(stream next = 255) ifFalse: [ self halt ].
+		putBytes: serialized.
+	^ cluster 
+]
+
+{ #category : #'as yet unclassified' }
+SoilGraphImporter >> replaceObject: anAGUser [ 
+	replacements add: (transaction objectIdOf: anAGUser) 
 ]
 
 { #category : #accessing }
@@ -161,5 +192,6 @@ SoilGraphImporter >> stream: aReadStream [
 
 { #category : #accessing }
 SoilGraphImporter >> transaction: anAGBaseTransaction [ 
-	transaction := anAGBaseTransaction 
+	transaction := anAGBaseTransaction.
+	soil := anAGBaseTransaction soil 
 ]