"
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 [

	^ self new 
		local: aFilePath;
		repository: aFossilFilePath;
		yourself
]

{ #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 : #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 >> 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 >> extra [

	^ self command: 'extra'
]

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

{ #category : #accessing }
FossilRepo >> fossilUv: anArgument arg2: 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 : #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 >> local [
	^ local
]

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

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

	local ifNotNil: [ ^ self local fullName ].
	^((self status lines detect: [ :line | line beginsWith: 'local-root:' ]) splitOn: ':') second trimmed
]

{ #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 : #wiki }
FossilRepo >> pageList [
	^ NeoJSONReader fromString: (self jsonWikiDataFor: 'list')  
]

{ #category : #authentication }
FossilRepo >> rawCapabilities [
	^ NeoJSONReader fromString: (self jsonDataFor: 'cap')
]

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

{ #category : #accessing }
FossilRepo >> remote: anUrlString [
	remote := anUrlString asUrl 
]

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

	^ repository
]

{ #category : #accessing }
FossilRepo >> repository: aFossilRepoFile [

	^ repository := aFossilRepoFile fullName
]

{ #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 [
	
	^ self command: 'status'
]

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

	^ self command: 'update'
]

{ #category : #accessing }
FossilRepo >> uvAdd: aFileRelativePath [

	^ self fossilUv: 'add' arg2: aFileRelativePath

]

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

	^ self fossilUv: 'sync' arg2: '-v'

]

{ #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')  
]