New Fossil class using GtSubProcessInMemory.

README.md

@@ -1,4 +1,13 @@
 # Fossil
 
 This repostory contains a set of utilities for using [Fossil SCM](https://fossil-scm.org/) within 
-[Pharo](https://pharo.org/)/[Grafoscopio](https://mutabit.com/grafoscopio/en.html).
+[Pharo](https://pharo.org/)/[Grafoscopio](https://mutabit.com/grafoscopio/en.html) . 
+
+To install this repository, *first* install [ExoRepo](https://code.sustrato.red/Offray/ExoRepo) and then run:
+
+
+```
+ExoRepo new
+	repository: 'https://code.sustrato.red/Offray/Fossil';
+	load.
+```

repository/BaselineOfFossil/BaselineOfFossil.class.st

@@ -15,17 +15,17 @@ BaselineOfFossil >> baseline: spec [
 		for: #common
 		do: [ 
 			"Dependencies"
-			spec 
+			"As NeoJSON is included in Pharo and GT, it is not declared as an extra dependency, so it uses the one already defined on the system"
-				baseline: 'NeoJSON' with: [ spec repository: 'github://svenvc/NeoJSON/repository' ];
+			spec
-				baseline: 'OSSubprocess' with: [ spec repository: 'github://pharo-contributions/OSSubprocess:master/repository'];
+				baseline: 'OSSubprocess' with: [ spec repository: 'github://pharo-contributions/OSSubprocess/repository']";
-				baseline: 'ProcessWrapper' with: [ spec repository: 'github://hernanmd/ProcessWrapper/repository' ].
+				baseline: 'ProcessWrapper' with: [ spec repository: 'github://hernanmd/ProcessWrapper/repository' ]".
 			
 			"Packages"
 			spec package: 'Fossil' with: [ spec requires:  #('NeoJSON') ].
 			spec for: #(#'MacOS' #'Unix') do: [
 					spec package: 'Fossil' with: [ spec requires: #('OSSubprocess') ] ].
-			spec for: #'Windows' do: [
+			"spec for: #'Windows' do: [
-					spec package: 'Fossil' with: [ spec requires: #('OSSubprocess') ] ].	
+					spec package: 'Fossil' with: [ spec requires: #('ProcessWrapper') ] ]".
 			
 			
 		]

repository/Fossil/Fossil.class.st

@@ -0,0 +1,16 @@
+Class {
+	#name : #Fossil,
+	#superclass : #Object,
+	#category : #Fossil
+}
+
+{ #category : #accessing }
+Fossil class >> all: subcommand [
+
+	Smalltalk os isWindows ifTrue: [ ^ self shouldBeImplemented ].
+	^ GtSubprocessWithInMemoryOutput new
+		shellCommand: 'fossil all ', subcommand;
+		runAndWait;
+		stdout
+		
+]

repository/Fossil/FossilRepo.class.st

@@ -13,7 +13,8 @@ Class {
 	#superclass : #Object,
 	#instVars : [
 		'local',
-		'remote'
+		'remote',
+		'repository'
 	],
 	#classInstVars : [
 		'executable'
@@ -32,15 +33,26 @@ FossilRepo class >> executable: aPathString [
 	executable := aPathString
 ]
 
+{ #category : #'instance creation' }
+FossilRepo class >> local: aFilePath repository: aFossilFilePath [
+	
+	| repo |
+	repo := self new 
+		local: aFilePath;
+		repository: aFossilFilePath.
+	repo remote = 'off'
+		ifTrue: [ repo remote: nil ]
+		ifFalse: [ repo remote: repo remote ].
+	^ repo
+]
+
 { #category : #accessing }
 FossilRepo class >> locateExecutable [
-	Smalltalk os isWindows ifTrue: [ ^ self ].
+	Smalltalk os isWindows ifTrue: [ ^ MiniDocs shouldBeImplemented ].
-	OSSUnixSubprocess new 
+	^ (GtSubprocessWithInMemoryOutput new 
-		command: 'which';
+		shellCommand: 'which fossil';
-		arguments: #('fossil') ;
+		runAndWait;
-		redirectStdout;
+		stdout) lines first 
-		runAndWaitOnExitDo: [ :process :outString | 
-			^ outString allButLast ] 
 ]
 
 { #category : #operation }
@@ -50,12 +62,25 @@ FossilRepo >> add: fileRelativePath [
 	
 	OSSUnixSubprocess new 
 		command: self class locateExecutable;
-		workingDirectory: self localFolderName;
+		workingDirectory: self localRoot;
 		arguments: { 'add' . fileRelativePath };
 		redirectStdout;
 		runAndWaitOnExitDo: [ :process :outString | ^ outString ] 
 ]
 
+{ #category : #accessing }
+FossilRepo >> addFiles: aCollection [
+
+	aCollection do: [ :each | self add: each ].
+]
+
+{ #category : #accessing }
+FossilRepo >> addUnversioned: aFileRelativePathFullname [
+
+	^ self fossilUv: 'add' and: aFileRelativePathFullname
+
+]
+
 { #category : #authentication }
 FossilRepo >> authTokenFor: anUserName withPassword: passwordString [
 	^ ((self loginAs: anUserName withPassword: passwordString) at: 'payload') at: 'authToken'
@@ -85,6 +110,28 @@ FossilRepo >> checkinsFor: relativeFilePath [
 	^ payload at: 'checkins'
 ]
 
+{ #category : #accessing }
+FossilRepo >> checkoutDateAndTime [
+
+	| date time splitedCheckout |
+	splitedCheckout := (self status at: 'checkout') splitOn: ' '.
+	date := splitedCheckout at: 2.
+	time := splitedCheckout at: 3.
+	^ (date, time) asZTimestamp
+]
+
+{ #category : #accessing }
+FossilRepo >> command: aCommandArgument [
+
+	OSSUnixSubprocess new 
+		command: 'fossil';
+		arguments: { aCommandArgument };
+		workingDirectory: self localRoot;
+		redirectStdout;
+		redirectStderr;
+		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
+]
+
 { #category : #operation }
 FossilRepo >> commit: message [
 	"I add a file to the working Fossil repository, given that both, the file and the repositor,
@@ -93,7 +140,7 @@ FossilRepo >> commit: message [
 	OSSUnixSubprocess new 
 		command: self class locateExecutable;
 		arguments: { 'commit' . '--no-warnings' . '-m' . message };
-		workingDirectory: self localFolderName;
+		workingDirectory: self localRoot;
 		redirectStdout;
 		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
 ]
@@ -114,7 +161,7 @@ FossilRepo >> commit: message withEnabledWarnings: aBoolean [
 			warningCommand.
 			'-m'.
 			message};
-		workingDirectory: self localFolderName;
+		workingDirectory: self localRoot;
 		redirectStdout;
 		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
 ]
@@ -124,21 +171,61 @@ FossilRepo >> createPage: pageName [
 	^ NeoJSONReader fromString: (self jsonWikiDataFor: 'create/', pageName) 
 ]
 
-{ #category : #operation }
+{ #category : #accessing }
-FossilRepo >> downloadZippedInto: aFolder [
+FossilRepo >> delete: fileRelativePath [
-	| zippedFileName zippedFile |
+	"I delete a file to the working Fossil repository, given that both, the file and the repositor,
-	self remote ifNil: [ ^ self ].
+	share the same root directory/folder."
-	zippedFileName := self remoteName , '.zip'.
-	zippedFile := FileLocator temp / zippedFileName.
-	GrafoscopioUtils 
-		downloadingFrom:  self remote /  'zip'
-		withMessage: 'Downloading zipped repository...'
-		into: aFolder.
-	aFolder / 'zip' renameTo:  zippedFileName.
-	^ zippedFile
-	
-			
 	
+	OSSUnixSubprocess new 
+		command: self class locateExecutable;
+		workingDirectory: self localRoot;
+		arguments: { 'delete' . fileRelativePath };
+		redirectStdout;
+		runAndWaitOnExitDo: [ :process :outString | ^ outString ] 
+]
+
+{ #category : #accessing }
+FossilRepo >> diff [
+
+	^ self command: 'diff'
+]
+
+{ #category : #accessing }
+FossilRepo >> exportHTMLUnversioned [
+
+	| htmlFileReferenceFullName |
+	htmlFileReferenceFullName := (self listUnversioned) 
+		select: [ :each | each endsWith: '.html' ].
+	htmlFileReferenceFullName do: [ :each | self exportUnversioned: each ].
+	^ htmlFileReferenceFullName
+]
+
+{ #category : #accessing }
+FossilRepo >> exportSTONUnversioned [
+
+	| stonFileReferenceFullName |
+	stonFileReferenceFullName := (self listUnversioned) 
+		select: [ :each | each endsWith: '.ston' ].
+	stonFileReferenceFullName do: [ :each | self exportUnversioned: each ].
+	^ stonFileReferenceFullName
+]
+
+{ #category : #accessing }
+FossilRepo >> exportUnversioned: fileReferenceFullName [
+
+	OSSUnixSubprocess new
+		command: 'fossil';
+		arguments: { 'uv' . 'export' . fileReferenceFullName . fileReferenceFullName };
+		workingDirectory: self localRoot;
+		redirectStdout;
+		redirectStderr;
+		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
+]
+
+{ #category : #accessing }
+FossilRepo >> extra [
+
+	^ self command: 'extra'
 ]
 
 { #category : #wiki }
@@ -146,6 +233,25 @@ FossilRepo >> fetchPage: pageName [
 	^ NeoJSONReader fromString: (self jsonWikiDataFor: 'get/', pageName) 
 ]
 
+{ #category : #accessing }
+FossilRepo >> firstCheckinFor: testRepoFile [
+	"Checkins are in reverse order"
+	^ (self checkinsFor: testRepoFile) last
+]
+
+{ #category : #accessing }
+FossilRepo >> fossilUv: anArgument and: aSecondArgument [
+
+	OSSUnixSubprocess new
+		command: 'fossil';
+		arguments: { 'uv' . anArgument . aSecondArgument };
+		workingDirectory: self localRoot;
+		redirectStdout;
+		redirectStderr;
+		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
+
+]
+
 { #category : #'as yet unclassified' }
 FossilRepo >> getFileContentsFor: anEmbeddedDocUrl [
 	"Given the web page contents for a file, hosted in Fossil, I detect all the standard 
@@ -189,11 +295,18 @@ FossilRepo >> init: absolutePathString [
 	OSSUnixSubprocess new 
 		command: self class locateExecutable;
 		arguments: { 'init' . absolutePathString };
-		workingDirectory: self localFolderName;
+		workingDirectory: self localRoot;
 		redirectStdout;
 		runAndWaitOnExitDo: [ :process :outString | ^ outString ] 
 ]
 
+{ #category : #testing }
+FossilRepo >> isOpen [
+
+	self status ifEmpty: [ ^ false ].
+	^ true
+]
+
 { #category : #utilities }
 FossilRepo >> isUnversioned: aFileNameWithRelativePath [
 
@@ -209,7 +322,7 @@ FossilRepo >> jsonDataFor: anUrlSegment [
 { #category : #querying }
 FossilRepo >> jsonStringFor: aFileName [
 	| baseUrl queryForJSONData |
-	baseUrl := self remote addPathSegments: #('json' 'finfo').
+	baseUrl := self remote copy addPathSegments:  #('json' 'finfo').
 	queryForJSONData := baseUrl queryAt: 'name' put: aFileName.
 	^ (ZnEasy get: queryForJSONData) contents.
 ]
@@ -239,6 +352,41 @@ FossilRepo >> lastVersionPath: aFileNameWithRelativePath [
 		ifFalse: [ ^ '/doc/tip/', aFileNameWithRelativePath ]
 ]
 
+{ #category : #accessing }
+FossilRepo >> list [
+
+	^ (self command: 'ls') lines collect: [:line |  line accentedCharactersCorrection  ].
+]
+
+{ #category : #accessing }
+FossilRepo >> listSeparatingMardeepFiles [
+
+	| lines output markdeepFiles otherFiles |
+	output := OrderedDictionary new.
+	lines := (self command: 'ls') lines.
+	
+	markdeepFiles := lines select: [ :line | line endsWith: '.md.html' ].
+	otherFiles := lines reject: [ :line | line endsWith: '.md.html'].
+	output
+		at: 'markdeep files'
+		put: {'file reference' -> markdeepFiles .
+			'url' -> (markdeepFiles collect: [ :ref | 
+												('https://', ((self remote splitOn: '@' ) 
+												at: 2), '/doc/trunk/', ref)asUrl ])
+		} asDictionary.
+	output
+		at: 'other files'
+		put: otherFiles.
+		
+	^ output
+]
+
+{ #category : #accessing }
+FossilRepo >> listUnversioned [
+
+	^ (self fossilUv: 'ls' and: '') lines
+]
+
 { #category : #accessing }
 FossilRepo >> local [
 	^ local
@@ -249,9 +397,11 @@ FossilRepo >> local: aLocalFilePath [
 	local := aLocalFilePath
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #accessing }
-FossilRepo >> localFolderName [
+FossilRepo >> localRoot [
-	^ self local parent fullName
+
+	local ifNotNil: [ ^ self local fullName ].
+	^ self status at: 'local-root:'
 ]
 
 { #category : #authentication }
@@ -272,11 +422,36 @@ FossilRepo >> loginUrlWithName: aUser andPassword: passwd [
 		queryAt: 'password' put: passwd.
 ]
 
+{ #category : #accessing }
+FossilRepo >> open [
+
+	OSSUnixSubprocess new 
+		command: 'fossil';
+		arguments: { 'open' . self repository. '-f' };
+		workingDirectory: self localRoot;
+		redirectStdout;
+		redirectStderr;
+		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
+]
+
+{ #category : #accessing }
+FossilRepo >> openAndUpdate [
+
+	^ self open; update
+]
+
 { #category : #wiki }
 FossilRepo >> pageList [
 	^ NeoJSONReader fromString: (self jsonWikiDataFor: 'list')  
 ]
 
+{ #category : #accessing }
+FossilRepo >> printOn: aStream [
+	super initialize.
+	aStream
+		nextPutAll: 'Repository: ', self remote asString
+]
+
 { #category : #authentication }
 FossilRepo >> rawCapabilities [
 	^ NeoJSONReader fromString: (self jsonDataFor: 'cap')
@@ -284,18 +459,79 @@ FossilRepo >> rawCapabilities [
 
 { #category : #accessing }
 FossilRepo >> remote [
-	^ remote
+
+	^ remote 
+	"TO DEBUG: Capture the context of this assignation without damaging the generaly of the accessor for other cases."
+	":= (self command: 'remote') copyWithout: Character lf"
 ]
 
 { #category : #accessing }
 FossilRepo >> remote: anUrlString [
-	remote := anUrlString asUrl 
+
+	anUrlString 
+		ifNil: [ remote := anUrlString ]
+		ifNotNil: [ remote := anUrlString asUrl ]
+	
 ]
 
-{ #category : #utilities }
+{ #category : #accessing }
-FossilRepo >> remoteName [
+FossilRepo >> renameFrom: currentName to: newName [
-	self remote ifNil: [ ^ self ].
+
-	^ self remote asUrl segments last
+	^ self renameFrom: currentName to: newName inSubfolder: self localRoot
+]
+
+{ #category : #accessing }
+FossilRepo >> renameFrom: currentName to: newName inSubfolder: aFolder [
+
+	OSSUnixSubprocess new
+		command: 'fossil';
+		arguments: { 
+				'rename'.
+				currentName basename.
+				newName basename};
+		workingDirectory: aFolder fullName;
+		redirectStdout;
+		redirectStderr;
+		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
+]
+
+{ #category : #accessing }
+FossilRepo >> repository [
+
+	repository ifNotNil: [ ^ repository ].
+	self isOpen ifFalse: [ ^ nil ].
+	^ repository := self status at: 'repository'.
+]
+
+{ #category : #accessing }
+FossilRepo >> repository: aFossilRepoFile [
+
+	repository := aFossilRepoFile "fullName"
+]
+
+{ #category : #operation }
+FossilRepo >> revert: aRelativeFilePath [
+	"I add a file to the working Fossil repository, given that both, the file and the repositor,
+	share the same root directory/folder."
+	
+	OSSUnixSubprocess new 
+		command: self class locateExecutable;
+		arguments: { 'revert' . aRelativeFilePath };
+		workingDirectory: self localRoot;
+		redirectStdout;
+		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
+]
+
+{ #category : #accessing }
+FossilRepo >> revertRemoteUnversioned [
+
+	OSSUnixSubprocess new
+		command: 'fossil';
+		arguments: { 'uv' . 'revert' };
+		workingDirectory: self localRoot;
+		redirectStdout;
+		redirectStderr;
+		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
 ]
 
 { #category : #utilities }
@@ -308,15 +544,60 @@ FossilRepo >> sanitize: aFileNameWithRelativePath [
 		ifTrue: [ ^ (aFileNameWithRelativePath copyFrom: 4 to: aFileNameWithRelativePath size)  ]
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #accessing }
 FossilRepo >> status [
-	OSSUnixSubprocess new
+	| status output missing edited added |
-		command: '/usr/bin/fossil';
+	status := self command: 'status'.
-		arguments: #('status');
+	output := OrderedDictionary new.
-		workingDirectory: self localFolderName;
+	
-		redirectStdout;
+	status linesDo: [ :line | | k  v temp commitLog | 
-		redirectStderr;
+		commitLog := OrderedCollection new.
-		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
+		temp := line splitOn: ': '.
+		temp size = 2 
+			ifTrue: [ 
+				k := temp  first.
+				v := temp second trimmed.
+				output at: k put: v 
+			]
+			ifFalse: [ commitLog add: line ].
+		output at: 'commitLog' put: commitLog 
+	].
+	edited := status lines select: [ :line | line beginsWith: 'EDITED' ].
+	output 
+		at: 'edited' 
+		put: (edited collect: 
+			[ :line | (line withoutPrefix: 'EDITED') trimmed accentedCharactersCorrection ]).
+			
+	added := status lines select: [ :line | line beginsWith: 'ADDED' ].
+	output 
+		at: 'added' 
+		put: (added collect: 
+			[ :line | (line withoutPrefix: 'ADDED') trimmed accentedCharactersCorrection ]).
+	
+	missing := status lines select: [ :line | line beginsWith: 'MISSING' ].
+	output 
+		at: 'missing' 
+		put: (missing collect: 
+			[ :line | (line withoutPrefix: 'MISSING') trimmed accentedCharactersCorrection ]).
+	^ output
+]
+
+{ #category : #accessing }
+FossilRepo >> syncUnversioned [
+
+	^ self fossilUv: 'sync' and: '-v'
+
+]
+
+{ #category : #accessing }
+FossilRepo >> update [
+
+	^ self command: 'update'
+]
+
+{ #category : #accessing }
+FossilRepo >> uuidFor: relativeFilePath [ 
+	 ^ (self firstCheckinFor: relativeFilePath) at: 'uuid'
 ]
 
 { #category : #authentication }