"
I model a fossil repository. For details about fossil see:

http://fossil-scm.org/

The protocols are named following Smalltalk conventions, but
also after the Fossil JSON API documentation at [1]

[1] https://docs.google.com/document/d/1fXViveNhDbiXgCuE7QDXQOKeFzf2qNUkBEgiUvoqFN4/view
"
Class {
	#name : #FossilRepo,
	#superclass : #Object,
	#instVars : [
		'local',
		'remote',
		'repository'
	],
	#classInstVars : [
		'executable'
	],
	#category : #Fossil
}

{ #category : #accessing }
FossilRepo class >> executable [
	^ executable ifNil: [ executable := self locateExecutable ]
]

{ #category : #accessing }
FossilRepo class >> executable: aPathString [
	"I define where the Fossil package is installed in this operative system."
	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 ].
	OSSUnixSubprocess new 
		command: 'which';
		arguments: #('fossil') ;
		redirectStdout;
		runAndWaitOnExitDo: [ :process :outString | 
			^ outString allButLast ] 
]

{ #category : #operation }
FossilRepo >> add: fileRelativePath [
	"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;
		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'
]

{ #category : #authentication }
FossilRepo >> capabilities [
	| payload name permissions |
	payload := self rawCapabilities at: 'payload'.
	name := payload at: 'name'.
	permissions := ((payload at: 'permissionFlags') select: [ :item | item value ]) keys.
	^ Dictionary new
		at: 'name' put: name;
		at: 'permissions' put: permissions;
		yourself.
]

{ #category : #querying }
FossilRepo >> checkinsFor: relativeFilePath [
	"I get all histotical checkins information for a full file name, wich includes relative path 
	in the repository (i.e: 'Doc/Es/Tutoriales/tutorial.ston' or 'index.html')"
	| payload |
	payload := (self jsonDataFor: relativeFilePath)  at: 'payload' ifAbsent: [ 
		 self inform: 
			'WARNING! Key not found, verify the file name you are looking in this repository'. 
		 ^ self ].
	^ 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,
	share the same root directory/folder."
	
	OSSUnixSubprocess new 
		command: self class locateExecutable;
		arguments: { 'commit' . '--no-warnings' . '-m' . message };
		workingDirectory: self localRoot;
		redirectStdout;
		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
]

{ #category : #operation }
FossilRepo >> commit: message withEnabledWarnings: aBoolean [
	"I add a file to the working Fossil repository, given that both, the file and the repositor,
	share the same root directory/folder."

	| warningCommand |
	warningCommand := aBoolean
		ifFalse: [ '' ]
		ifTrue: [ '--no-warnings' ].
	OSSUnixSubprocess new
		command: self class locateExecutable;
		arguments:
			{'commit'.
			warningCommand.
			'-m'.
			message};
		workingDirectory: self localRoot;
		redirectStdout;
		runAndWaitOnExitDo: [ :process :outString | ^ outString ]
]

{ #category : #wiki }
FossilRepo >> createPage: pageName [
	^ NeoJSONReader fromString: (self jsonWikiDataFor: 'create/', pageName) 
]

{ #category : #accessing }
FossilRepo >> delete: fileRelativePath [
	"I delete 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;
		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 }
FossilRepo >> fetchPage: pageName [
	^ NeoJSONReader fromString: (self jsonWikiDataFor: 'get/', pageName) 
]

{ #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 
	page decorations (chrome) and strip them to provide only file contents, contained between
	<blockquote><pre> HTML tags.."

	| pageContentLines blockQuoteStart blockQuoteEnd fileContentLines fileContent |
	pageContentLines := (self getPageContentsFor: anEmbeddedDocUrl) lines.
	pageContentLines
		doWithIndex: [ :line :index | 
			line = '<blockquote><pre>'
				ifTrue: [ blockQuoteStart := index ].
			line = '</pre></blockquote>'
				ifTrue: [ blockQuoteEnd := index ] ].
	fileContentLines := pageContentLines
		copyFrom: blockQuoteStart + 1
		to: blockQuoteEnd - 1.
	fileContent := WriteStream on: ''.
	fileContentLines do: [ :line | fileContent nextPutAll: line; crlf ].
	^ fileContent contents.
]

{ #category : #utilities }
FossilRepo >> getPageContentsFor: anEmbeddedDocUrl [
	"I use the Fossil web interface to get the contents of a file.
	I'm useful if the file is posted online, but the repository contents are
	not locally available.
	
	anEmbeddedDocUrl should have the schema presented at:
	
	https://www.fossil-scm.org/xfer/doc/trunk/www/embeddeddoc.wiki"

	^ (ZnEasy get: anEmbeddedDocUrl, '?mimetype=text/plain') contents.
]

{ #category : #operation }
FossilRepo >> init: absolutePathString [
	"I init a repository in a given location."
	Smalltalk os isWindows ifTrue: [ ^ self ].
	absolutePathString asFileReference exists ifTrue: [ ^ self ].
	OSSUnixSubprocess new 
		command: self class locateExecutable;
		arguments: { 'init' . absolutePathString };
		workingDirectory: self localRoot;
		redirectStdout;
		runAndWaitOnExitDo: [ :process :outString | ^ outString ] 
]

{ #category : #testing }
FossilRepo >> isOpen [

	self status ifEmpty: [ ^ false ].
	^ true
]

{ #category : #utilities }
FossilRepo >> isUnversioned: aFileNameWithRelativePath [

	^ (aFileNameWithRelativePath beginsWith: 'uv')
]

{ #category : #utilities }
FossilRepo >> jsonDataFor: anUrlSegment [
	
	^ NeoJSONReader fromString: (self jsonStringFor: anUrlSegment)
]

{ #category : #querying }
FossilRepo >> jsonStringFor: aFileName [
	| baseUrl queryForJSONData |
	baseUrl := self remote addPathSegments: #('json' 'finfo').
	queryForJSONData := baseUrl queryAt: 'name' put: aFileName.
	^ (ZnEasy get: queryForJSONData) contents.
]

{ #category : #wiki }
FossilRepo >> jsonWikiDataFor: anUrlSegment [
	^ ZnClient new
		get: (self wikiRoot addPathSegment: anUrlSegment);
		contents.
]

{ #category : #querying }
FossilRepo >> lastHashNumberFor: aFileName [
	"I'm useful to see if local versions of files are updated to the last versions of the
	online repository"
	^ (self checkinsFor: aFileName) first at: 'uuid'
]

{ #category : #utilities }
FossilRepo >> lastVersionPath: aFileNameWithRelativePath [
	"I dicern if my argument concerns to a versioned or an unversioned file,
	and return a relative route to the last version of the file in the first
	case or the unversioned one."

	(self isUnversioned: aFileNameWithRelativePath) 
		ifTrue: [ ^ '/', 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
]

{ #category : #accessing }
FossilRepo >> local: aLocalFilePath [
	local := aLocalFilePath
]

{ #category : #accessing }
FossilRepo >> localRoot [

	local ifNotNil: [ ^ self local fullName ].
	^ self status at: 'local-root:'
]

{ #category : #authentication }
FossilRepo >> loginAs: anUserName withPassword: password [
	| jsonData |
	jsonData := ZnClient new
		url: (self loginUrlWithName: anUserName andPassword: password);
		get;
		contents.
	^ NeoJSONReader fromString: jsonData
]

{ #category : #authentication }
FossilRepo >> loginUrlWithName: aUser andPassword: passwd [
	^ self jsonRoot 
		addPathSegment: 'login';
		queryAt: 'name' put: aUser;
		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 : #authentication }
FossilRepo >> rawCapabilities [
	^ NeoJSONReader fromString: (self jsonDataFor: 'cap')
]

{ #category : #accessing }
FossilRepo >> remote [

	^ remote := (self command: 'remote') copyWithout: Character lf
]

{ #category : #accessing }
FossilRepo >> remote: anUrlString [

	anUrlString 
		ifNil: [ remote := anUrlString ]
		ifNotNil: [ remote := anUrlString asUrl ]
	
]

{ #category : #accessing }
FossilRepo >> renameFrom: currentName to: newName [

	^ 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 }
FossilRepo >> sanitize: aFileNameWithRelativePath [
	"I dicern if my argument concerns to a versioned or an unversioned file,
	and return a relative path to put the file."

	(self isUnversioned: aFileNameWithRelativePath) 
		ifFalse: [ ^ aFileNameWithRelativePath ]
		ifTrue: [ ^ (aFileNameWithRelativePath copyFrom: 4 to: aFileNameWithRelativePath size)  ]
]

{ #category : #accessing }
FossilRepo >> status [
	| status output missing edited added |
	status := self command: 'status'.
	output := OrderedDictionary new.
	
	status linesDo: [ :line | | k  v temp commitLog | 
		commitLog := OrderedCollection new.
		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 : #authentication }
FossilRepo >> whoAmI [
	^ NeoJSONReader fromString: (self jsonDataFor: 'whoami')
]

{ #category : #wiki }
FossilRepo >> wikiRoot [
	^ self remote
		addPathSegments: #('json' 'wiki') 
		"addPathSegment: 'wiki' "
]

{ #category : #wiki }
FossilRepo >> wikiTimeline [
	^ NeoJSONReader fromString: (self jsonWikiDataFor: 'timeline')  
]