Issue #4: basic gslist.solo support added (-ljc)

bin/gslist.solo

@@ -0,0 +1,123 @@
+#!/usr/bin/env superdoit_solo
+customoptions
+{
+SuperDoitOptionalOptionWithNoArg long: 'help'.
+SuperDoitOptionalOptionWithNoArg long: 'debug'.
+SuperDoitOptionalOptionWithNoArg long: 'debugGem'.
+SuperDoitOptionalOptionWithRequiredArg long: 'registry'.
+SuperDoitOptionalOptionWithNoArg long: 'verbose'.
+SuperDoitOptionalOptionWithNoArg long: 'long' short: 'l'.
+SuperDoitOptionalOptionWithNoArg long: 'json' short: 'j'.
+SuperDoitOptionalOptionWithNoArg long: 'removeLocks' short: 'c'.
+}
+%
+Usage
+-----
+USAGE $basename [--help] [--debug]  [--debugGem] [--verbose] \
+                --registry=<registry-name> <stone-name>
+
+DESCRIPTION
+  Run gslist command using the GEMSTONE associated with the named stone.
+
+OPTIONS
+	Note that the standard shortcuts options are not supported, since we weant
+  to be faithful to the startnetldi options and they comprise a big chunk
+  of the alphabet.
+
+  --help        display usage message
+  --debug       bring up topaz debugger in the event of a script error
+  --debugGem    If terminal is connected to stdout, bring up debugger. If not,
+                dump stack to stdout and wait for topaz to attach using topaz
+                DEBUGGEM command.
+  --verbose     Verbose logging enabled.
+  #
+  # standard startnetldi options (currently supported)
+  #
+  -l, --long        cause netldi to print extra information to its log file.
+  -j, --json        Print extra long listing in JSON format to stdout. Implies -q and -x
+  -c, --removeLocks Remove locks of killed servers.
+
+EXAMPLES
+  $basename --help
+  $basename --debug
+  $basename --debugGem
+  $basename --registry=bosch 3.7.0 
+  $basename --registry=bosch 3.7.0 --long --removeLocks
+  # if launched from stone directory where .GDKStoneSpec.ston is present
+  $basename  
+  $basename -l
+  $basename -lc
+-----
+%
+instvars
+gemstoneVersionString
+%
+specs
+[
+RwLoadSpecificationV2 {
+	#projectName : 'GsDevKit_stones',
+	#projectSpecFile : 'rowan/project.ston',
+	#componentNames : [
+		'Core',
+		'Solo'
+	],
+	#platformProperties : {
+		'gemstone' : {
+			'allusers' : {
+				#defaultSymbolDictName : 'Globals'
+			}
+		}
+	},
+	#comment : ''
+},
+RwLoadSpecificationV2 {
+	#projectName : 'GsCommands',
+	#projectSpecFile : 'rowan/project.ston',
+	#diskUrl : '$GEMSTONE/examples/GsCommands/projectsHome/GsCommands',
+	#componentNames : [
+		'Commands'
+	],
+	#platformProperties : {
+		'gemstone' : {
+			'allusers' : {
+				#defaultSymbolDictName : 'UserGlobals'
+			}
+		}
+	},
+	#comment : ''
+}
+]
+%
+method
+gemstoneVersionString
+	^ gemstoneVersionString ifNil: [ System gemVersionReport at: 'gsVersion' ]
+%
+doit
+	| registryClass stoneName stoneSpec registry output |
+	self preDoitSpecLoad: [:spec | 
+		spec projectName = 'GsCommands'
+			ifTrue: [ spec projectsHome: '$GEMSTONE/examples/GsCommands/projectsHome' ]
+			ifFalse: [ spec projectsHome: self dirname asFileReference parent parent ] ].
+	registryClass := (self globalNamed: 'GDKRegistry').	
+	self verbose
+		ifTrue: [ (self globalNamed: 'GDKGsDevKit_stonesBase') verbose: true ].
+	self positionalArgs size = 0
+		ifTrue: [
+			| specFile |
+			specFile := FileLocator workingDirectory asFileReference / '.GDKStoneSpec.ston'.
+			stoneSpec := (self globalNamed: 'GDKAbstractRegistryStore') fromPath: specFile ifAbsent: [].
+			gemstoneVersionString := stoneSpec gemstoneVersionString ]
+		ifFalse: [
+			| stonesRegistry |
+			self positionalArgs size > 1 
+				ifTrue: [ self error: 'Expected a single positional argument: <stone-name>, not ', self positionalArgs size printString, ' positional arguments' ].
+			stoneName := self positionalArgs at: 1.
+			self registry
+				ifNil: [ self error: '--registry option must be specified when <stone-name> is specified' ].
+			stonesRegistry := registryClass stonesRegistryNamed: self registry.
+			stoneSpec := stonesRegistry stoneNamed: stoneName ].
+	registry := stoneSpec registry.
+	output := registry gslist: self withSuperDoitOptions: true.
+	self stdout lf; nextPutAll: output; lf.
+	^ self noResult
+%

src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/registry.st

@@ -0,0 +1,5 @@
+accessing
+registry
+	^ GDKAbstractRegistryStore
+		fromPath: self parentRegistryPath
+		ifAbsent: [ self error: 'Registry not found at ' , self parentRegistryPath printString ]

src/GsDevKit_stones-Core.package/GDKStoneSpec.class/instance/startNetldi.withSuperDoitOptions..st

@@ -4,7 +4,7 @@ startNetldi: superDoitScriptOrNil withSuperDoitOptions: superDoitOptionsBoolean
 		debugLogging
 		restart"
 
-	| scriptPath stdout exitStatus commandLine arrayOfOutputs debugLogging restart |
+	| scriptPath stdout exitStatus commandLine output debugLogging restart |
 	scriptPath := ''.
 	restart := debugLogging := false.
 	stdout := superDoitScriptOrNil
@@ -42,7 +42,7 @@ startNetldi: superDoitScriptOrNil withSuperDoitOptions: superDoitOptionsBoolean
 				lf;
 				nextPutAll: commandLine;
 				yourself ].
-	[ arrayOfOutputs := GsHostProcess execute: commandLine ]
+	[ output := GsHostProcess execute: commandLine ]
 		on: ChildError
 		do: [ :ex | 
 			"exit status:
@@ -52,7 +52,7 @@ startNetldi: superDoitScriptOrNil withSuperDoitOptions: superDoitOptionsBoolean
 				3 or above, an error occurred and the specified netldi was not started"
 			exitStatus := ex status ].
 	exitStatus = 0
-		ifTrue: [ stdout nextPutAll: (arrayOfOutputs at: 1)	"stdout" ]
+		ifTrue: [ stdout nextPutAll: output	"stdout" ]
 		ifFalse: [ 
 			(exitStatus = 1 or: [ exitStatus = 2 ])
 				ifTrue: [ stdout nextPutAll: 'netldi is already running (' , exitStatus printString , ')' ]

src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/gslist.st

@@ -0,0 +1,3 @@
+runtime
+gslist
+	^ self gslist: nil withSuperDoitOptions: false

src/GsDevKit_stones-Core.package/GDKStonesRegistry.class/instance/gslist.withSuperDoitOptions..st

@@ -0,0 +1,92 @@
+runtime
+gslist: superDoitScriptOrNil withSuperDoitOptions: superDoitOptionsBoolean
+	"runs gslist and returns the output of gslist or error, if not able to run gslist"
+
+	"if superDoitOptionsBoolean is true, then superDoitScriptOrNil is expected to respond to the following messages:
+		long
+		json
+		gemstoneVersionString
+		removeLocks"
+
+	| stdout scriptPath exitStatus commandLine gslistOutput verbose long json oldGemstone removeLocks |
+	verbose := GDKGsDevKit_stonesBase verbose.
+	scriptPath := ' '.
+	removeLocks := json := long := false.
+	stdout := superDoitScriptOrNil
+		ifNotNil: [ 
+			scriptPath := ' (from ' , superDoitScriptOrNil scriptPath , ') '.
+			superDoitOptionsBoolean
+				ifTrue: [ 
+					long := superDoitScriptOrNil long.
+					json := superDoitScriptOrNil json.
+					removeLocks := superDoitScriptOrNil removeLocks ].
+			superDoitScriptOrNil stdout ]
+		ifNil: [ GsFile stdout ].
+	verbose
+		ifTrue: [ 
+			stdout
+				lf;
+				nextPutAll:
+						'======  starting gslist at' , scriptPath , DateAndTime now printString;
+				lf ].
+	exitStatus := 0.
+	[ 
+	oldGemstone := System gemEnvironmentVariable: 'GEMSTONE'.
+	System
+		gemEnvironmentVariable: 'GEMSTONE'
+		put:
+			(self products
+				at: superDoitScriptOrNil gemstoneVersionString
+				ifAbsent: [ System gemEnvironmentVariable: 'GEMSTONE' ]).
+	commandLine := '$GEMSTONE/bin/gslist' asFileReference pathString.
+	long
+		ifTrue: [ commandLine add: ' -l' ].
+	json
+		ifTrue: [ commandLine add: ' -j' ].
+	removeLocks
+		ifTrue: [ commandLine add: ' -c' ].
+	verbose
+		ifTrue: [ 
+			stdout
+				lf;
+				nextPutAll: commandLine;
+				lf;
+				yourself ].
+	[ gslistOutput := GsHostProcess execute: commandLine ]
+		on: ChildError
+		do: [ :ex | 
+			" Exit Status: 0 (OK)
+						1 (No servers found)
+						2 (Stale lock(s) removed)
+						3, or 4  (Fatal error)"
+			exitStatus := ex status ] ]
+		ensure: [ System gemEnvironmentVariable: 'GEMSTONE' put: oldGemstone ].
+	exitStatus = 0
+		ifTrue: [ 
+			verbose
+				ifTrue: [ stdout nextPutAll: gslistOutput	"stdout" ]
+				ifFalse: [ ^ gslistOutput ] ]
+		ifFalse: [ 
+			exitStatus = 1
+				ifTrue: [ 
+					verbose
+						ifTrue: [ stdout nextPutAll: 'no servers found (' , exitStatus printString , ')' ]
+						ifFalse: [ ^ gslistOutput ] ]
+				ifFalse: [ 
+					exitStatus = 2
+						ifTrue: [ 
+							verbose
+								ifTrue: [ stdout nextPutAll: 'stale locks removed (' , exitStatus printString , ')' ]
+								ifFalse: [ ^ gslistOutput ] ]
+						ifFalse: [ 
+							exitStatus >= 3
+								ifTrue: [ 
+									verbose
+										ifTrue: [ stdout nextPutAll: 'gslist failed to start (' , exitStatus printString , ')' ]
+										ifFalse: [ self error: 'gslist failed to start(' , exitStatus printString , ')' ] ] ] ] ].
+	verbose
+		ifTrue: [ 
+			stdout
+				lf;
+				nextPutAll: '****************************************';
+				lf ]