Offray/Fossil
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Compare commits

base: Offray:master
Branches Tags
Offray:master
Offray:multiplatfrom
..
compare: Offray:multiplatfrom
Branches Tags
Offray:master
Offray:multiplatfrom

No commits in common. "master" and "multiplatfrom" have entirely different histories.
master ... multiplatf

4 changed files with 51 additions and 357 deletions
Show Stats Expand all files Collapse all files

11
README.md
View File

@ -1,13 +1,4 @@
# 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) .
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.
```
[Pharo](https://pharo.org/)/[Grafoscopio](https://mutabit.com/grafoscopio/en.html).

12
repository/BaselineOfFossil/BaselineOfFossil.class.st
View File

@ -15,17 +15,17 @@ BaselineOfFossil >> baseline: spec [
for: #common
do: [
"Dependencies"
"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"
spec
baseline: 'OSSubprocess' with: [ spec repository: 'github://pharo-contributions/OSSubprocess/repository']";
baseline: 'ProcessWrapper' with: [ spec repository: 'github://hernanmd/ProcessWrapper/repository' ]".
spec
baseline: 'NeoJSON' with: [ spec repository: 'github://svenvc/NeoJSON/repository' ];
baseline: 'OSSubprocess' with: [ spec repository: 'github://pharo-contributions/OSSubprocess:master/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 package: 'Fossil' with: [ spec requires: #('ProcessWrapper') ] ]".
spec for: #'Windows' do: [
spec package: 'Fossil' with: [ spec requires: #('OSSubprocess') ] ].
]

16
repository/Fossil/Fossil.class.st
View File

@ -1,16 +0,0 @@
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
]

369
repository/Fossil/FossilRepo.class.st
View File

@ -13,8 +13,7 @@ Class {
#superclass : #Object,
#instVars : [
'local',
'remote',
'repository'
'remote'
],
#classInstVars : [
'executable'
@ -33,26 +32,15 @@ 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: [ ^ MiniDocs shouldBeImplemented ].
^ (GtSubprocessWithInMemoryOutput new
shellCommand: 'which fossil';
runAndWait;
stdout) lines first
Smalltalk os isWindows ifTrue: [ ^ self ].
OSSUnixSubprocess new
command: 'which';
arguments: #('fossil') ;
redirectStdout;
runAndWaitOnExitDo: [ :process :outString |
^ outString allButLast ]
]
{ #category : #operation }
@ -62,25 +50,12 @@ FossilRepo >> add: fileRelativePath [
OSSUnixSubprocess new
command: self class locateExecutable;
workingDirectory: self localRoot;
workingDirectory: self localFolderName;
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'
@ -110,28 +85,6 @@ 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,
@ -140,7 +93,7 @@ FossilRepo >> commit: message [
OSSUnixSubprocess new
command: self class locateExecutable;
arguments: { 'commit' . '--no-warnings' . '-m' . message };
workingDirectory: self localRoot;
workingDirectory: self localFolderName;
redirectStdout;
runAndWaitOnExitDo: [ :process :outString | ^ outString ]
]
@ -161,7 +114,7 @@ FossilRepo >> commit: message withEnabledWarnings: aBoolean [
warningCommand.
'-m'.
message};
workingDirectory: self localRoot;
workingDirectory: self localFolderName;
redirectStdout;
runAndWaitOnExitDo: [ :process :outString | ^ outString ]
]
@ -171,61 +124,21 @@ 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."
{ #category : #operation }
FossilRepo >> downloadZippedInto: aFolder [
| zippedFileName zippedFile |
self remote ifNil: [ ^ self ].
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 }
@ -233,25 +146,6 @@ 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
@ -295,18 +189,11 @@ FossilRepo >> init: absolutePathString [
OSSUnixSubprocess new
command: self class locateExecutable;
arguments: { 'init' . absolutePathString };
workingDirectory: self localRoot;
workingDirectory: self localFolderName;
redirectStdout;
runAndWaitOnExitDo: [ :process :outString | ^ outString ]
]
{ #category : #testing }
FossilRepo >> isOpen [
self status ifEmpty: [ ^ false ].
^ true
]
{ #category : #utilities }
FossilRepo >> isUnversioned: aFileNameWithRelativePath [
@ -322,7 +209,7 @@ FossilRepo >> jsonDataFor: anUrlSegment [
{ #category : #querying }
FossilRepo >> jsonStringFor: aFileName [
| baseUrl queryForJSONData |
baseUrl := self remote copy addPathSegments: #('json' 'finfo').
baseUrl := self remote addPathSegments: #('json' 'finfo').
queryForJSONData := baseUrl queryAt: 'name' put: aFileName.
^ (ZnEasy get: queryForJSONData) contents.
]
@ -352,41 +239,6 @@ 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
@ -397,11 +249,9 @@ FossilRepo >> local: aLocalFilePath [
local := aLocalFilePath
]
{ #category : #accessing }
FossilRepo >> localRoot [
local ifNotNil: [ ^ self local fullName ].
^ self status at: 'local-root:'
{ #category : #'as yet unclassified' }
FossilRepo >> localFolderName [
^ self local parent fullName
]
{ #category : #authentication }
@ -422,36 +272,11 @@ 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')
@ -459,79 +284,18 @@ FossilRepo >> rawCapabilities [
{ #category : #accessing }
FossilRepo >> 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"
^ remote
]
{ #category : #accessing }
FossilRepo >> remote: anUrlString [
anUrlString
ifNil: [ remote := anUrlString ]
ifNotNil: [ remote := anUrlString asUrl ]
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 >> remoteName [
self remote ifNil: [ ^ self ].
^ self remote asUrl segments last
]
{ #category : #utilities }
@ -544,60 +308,15 @@ FossilRepo >> sanitize: aFileNameWithRelativePath [
ifTrue: [ ^ (aFileNameWithRelativePath copyFrom: 4 to: aFileNameWithRelativePath size) ]
]
{ #category : #accessing }
{ #category : #'as yet unclassified' }
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 : #accessing }
FossilRepo >> uuidFor: relativeFilePath [
^ (self firstCheckinFor: relativeFilePath) at: 'uuid'
OSSUnixSubprocess new
command: '/usr/bin/fossil';
arguments: #('status');
workingDirectory: self localFolderName;
redirectStdout;
redirectStderr;
runAndWaitOnExitDo: [ :process :outString | ^ outString ]
]
{ #category : #authentication }