Code ported to GS64 from Pharo package System-BasicCommandLineHandler

source/Launchpad-GS64-Extensions-Tests/CommandLineArgumentsTest.class.st

@@ -0,0 +1,89 @@
+"
+That class tests the API given by AbstractUserInput. Since that class is obviously abstract, it can't be instantiated, the tests are running on CommandLine (which inherits from AbstractUserInput)
+"
+Class {
+	#name : #CommandLineArgumentsTest,
+	#superclass : #TestCase,
+	#instVars : [
+		'commandLine'
+	],
+	#category : #'Launchpad-GS64-Extensions-Tests'
+}
+
+{ #category : #accessing }
+CommandLineArgumentsTest >> commandLine [
+	^ commandLine
+]
+
+{ #category : #accessing }
+CommandLineArgumentsTest >> parameters [
+	^ #('noOpt1' 'noOpt2.txt' 'noOpt3.avi' '--option1' 'opt11' 'opt12.txt' 'opt13.avi' '--option2' '--option3' 'opt31.st' 'opt32' '--option4' '--option5=option5Value' '-o' 'oValue')
+]
+
+{ #category : #running }
+CommandLineArgumentsTest >> setUp [
+	super setUp.
+	commandLine := CommandLineArguments withArguments: self parameters
+]
+
+{ #category : #tests }
+CommandLineArgumentsTest >> testAllFileTyped [
+	self assert: (self commandLine allFilesWithExtension: #txt) equals: #('noOpt2.txt' 'opt12.txt').
+	self assertEmpty: (self commandLine allFilesWithExtension: #foo)
+]
+
+{ #category : #tests }
+CommandLineArgumentsTest >> testAllParameters [
+	self assertCollection: self commandLine arguments equals: self parameters
+]
+
+{ #category : #tests }
+CommandLineArgumentsTest >> testHasFilesTyped [
+	self assert: (self commandLine hasFileWithExtension: #txt).
+	self deny: (self commandLine hasFileWithExtension: #foo)
+]
+
+{ #category : #tests }
+CommandLineArgumentsTest >> testHasOption [
+	self assert: (self commandLine hasOption: #option1).
+	self assert: (self commandLine hasOption: #option4).
+	self assert: (self commandLine hasOption: #option5).
+	self assert: (self commandLine hasOption: #o).
+	self deny: (self commandLine hasOption: #foo).
+	self deny: (self commandLine hasOption: #option5Value)
+]
+
+{ #category : #tests }
+CommandLineArgumentsTest >> testHasParameters [
+	self assert: (self commandLine hasArguments)
+]
+
+{ #category : #tests }
+CommandLineArgumentsTest >> testOptionAt [
+	self should: [ self commandLine optionAt: #option1 ] raise: Error.
+	self should: [ self commandLine optionAt: #option4 ] raise: Error.
+
+	self assert: (self commandLine optionAt: #option5) equals: 'option5Value'.
+	self should: [ self commandLine optionAt: #foo ] raise: Error.
+
+	self assert: (self commandLine optionAt: #o) equals: 'oValue'.
+	self should: [ self commandLine optionAt: #x ] raise: Error
+]
+
+{ #category : #tests }
+CommandLineArgumentsTest >> testOptionAtifAbsent [
+	self assert: (self commandLine optionAt: #option1 ifAbsent: [ nil ]) equals: nil.
+	self assert: (self commandLine optionAt: #option4 ifAbsent: [ nil ]) equals: nil.
+	self assert: (self commandLine optionAt: #option5) equals: 'option5Value'.
+	self assert: (self commandLine optionAt: #foo ifAbsent: [ nil ]) equals: nil.
+	self assert: (self commandLine optionAt: #o) equals: 'oValue'.
+	self assert: (self commandLine optionAt: #x ifAbsent: [ nil ]) equals: nil
+]
+
+{ #category : #tests }
+CommandLineArgumentsTest >> testParameterAt [
+	self assert: (self commandLine argumentAt: 1) equals: 'noOpt1'.
+	self assert: (self commandLine argumentAt: 4) equals: '--option1'.
+	self deny: (self commandLine argumentAt: 5) equals: 'foo'.
+	self deny: (self commandLine argumentAt: 1) isNil
+]

source/Launchpad-GS64-Extensions-Tests/CommandLineHandlerTest.class.st

@@ -0,0 +1,77 @@
+Class {
+	#name : #CommandLineHandlerTest,
+	#superclass : #TestCase,
+	#category : #'Launchpad-GS64-Extensions-Tests'
+}
+
+{ #category : #utilities }
+CommandLineHandlerTest >> argumentsWith: aCollection [
+	^ CommandLineArguments withArguments: aCollection
+]
+
+{ #category : #tests }
+CommandLineHandlerTest >> testBasicCommandlineHandler [
+
+	| args |
+	args := self argumentsWith: #().
+	"BasicCommandLineHandler gets activated by default on image startup, so there is no need to activate it in a nother case"
+	self deny: (BasicCommandLineHandler isResponsibleFor: args).
+	"The BasicCommandLineHandler should always delegate to the PharoCommandLineHandler if it is present"
+	self
+		assert: BasicCommandLineHandler new selectedHandler
+		equals: PharoCommandLineHandler
+]
+
+{ #category : #tests }
+CommandLineHandlerTest >> testResponsibilityDefault [
+	| args |
+	args := self argumentsWith: #('--help').
+	self assert: (PharoCommandLineHandler isResponsibleFor: args).
+	self deny: (STCommandLineHandler isResponsibleFor: args).
+	self deny: (EvaluateCommandLineHandler isResponsibleFor: args)
+]
+
+{ #category : #tests }
+CommandLineHandlerTest >> testResponsibilityEval [
+	| args |
+	args := self argumentsWith: #('eval' '1+2').
+	self assert: (PharoCommandLineHandler isResponsibleFor: args).
+	self deny: (STCommandLineHandler isResponsibleFor: args).
+	self assert: (EvaluateCommandLineHandler isResponsibleFor: args).
+
+	args := self argumentsWith: #('-e' '1+2').
+	self assert: (PharoCommandLineHandler isResponsibleFor: args).
+	self deny: (STCommandLineHandler isResponsibleFor: args).
+	self assert: (EvaluateCommandLineHandler isResponsibleFor: args).
+
+	args := self argumentsWith: #('--evaluate' '1+2').
+	self assert: (PharoCommandLineHandler isResponsibleFor: args).
+	self deny: (STCommandLineHandler isResponsibleFor: args).
+	self assert: (EvaluateCommandLineHandler isResponsibleFor: args)
+]
+
+{ #category : #tests }
+CommandLineHandlerTest >> testResponsibilitySt [
+	| args |
+	args := self argumentsWith: #('/foo/bar/myScript.st').
+	self assert: (PharoCommandLineHandler isResponsibleFor: args).
+	self assert: (STCommandLineHandler isResponsibleFor: args).
+	self deny: (EvaluateCommandLineHandler isResponsibleFor: args).
+
+	args := self argumentsWith: #('st' '/foo/bar/myScript.st').
+	self assert: (PharoCommandLineHandler isResponsibleFor: args).
+	self assert: (STCommandLineHandler isResponsibleFor: args).
+	self deny: (EvaluateCommandLineHandler isResponsibleFor: args)
+]
+
+{ #category : #tests }
+CommandLineHandlerTest >> testSelectHandlersCodeLoader [
+	| args handlers |
+	args := self argumentsWith: #('/foo/bar/myScript.st').
+	handlers := CommandLineHandler selectHandlersFor: args.
+	self assert: handlers first equals: STCommandLineHandler.
+
+	args := self argumentsWith: #('/foo/bar/myScript.st' '--verbose').
+	handlers := CommandLineHandler selectHandlersFor: args.
+	self assert: handlers first equals: STCommandLineHandler
+]

source/Launchpad-GS64-Extensions-Tests/package.st

@@ -0,0 +1 @@
+Package { #name : #'Launchpad-GS64-Extensions-Tests' }

source/Launchpad-GS64-Extensions/CommandLineArguments.class.st

@@ -0,0 +1,183 @@
+"
+The CommandLineArguments represents the arguments passed to the image.
+In the following case,
+
+	$PHARO_VM myImage.image --foo bar
+	
+`CommandLineArguments default` contains {'--foo'. 'bar'}.
+"
+Class {
+	#name : #CommandLineArguments,
+	#superclass : #Object,
+	#instVars : [
+		'arguments'
+	],
+	#classInstVars : [
+		'singleton'
+	],
+	#category : #'Launchpad-GS64-Extensions'
+}
+
+{ #category : #'instance creation' }
+CommandLineArguments class >> default [
+	^singleton ifNil: [ singleton := self new ]
+]
+
+{ #category : #'instance creation' }
+CommandLineArguments class >> withArguments: aCollection [
+	^ self basicNew
+		initializeWithArguments: aCollection;
+		yourself
+]
+
+{ #category : #accessing }
+CommandLineArguments >> allFilesWithExtension: anExtension [
+	^ self arguments select: [ :arg|
+		arg endsWith: anExtension ]
+]
+
+{ #category : #accessing }
+CommandLineArguments >> argumentAt: index [
+	^ arguments at: index
+]
+
+{ #category : #accessing }
+CommandLineArguments >> arguments [
+	^ arguments
+]
+
+{ #category : #testing }
+CommandLineArguments >> commandLineArguments [
+	"self commandLineArguments"
+
+	| documentPath args |
+
+	args := OrderedCollection withAll: Smalltalk arguments.
+	documentPath := Smalltalk vm documentPath.
+	documentPath isEmptyOrNil
+		ifFalse: [ args addFirst: documentPath ].
+ 	^ args
+]
+
+{ #category : #copying }
+CommandLineArguments >> copySubcommand [
+	"return a new copy of this CommandLine without the first arguments"
+	^ self class withArguments: arguments allButFirst
+]
+
+{ #category : #copying }
+CommandLineArguments >> copyWithoutPassword [
+	^ self class withArguments: (arguments reject: [ :each | each beginsWith: '--deploymentPassword' ])
+]
+
+{ #category : #testing }
+CommandLineArguments >> hasArguments [
+	^ arguments size > 0
+]
+
+{ #category : #testing }
+CommandLineArguments >> hasFileWithExtension: aFileExtension [
+	"return true if the first argument has the given file extension"
+	^ self arguments anySatisfy: [ :arg|
+		arg endsWith: aFileExtension]
+]
+
+{ #category : #testing }
+CommandLineArguments >> hasOption: aString [
+	| option |
+	option := (aString size = 1
+					ifTrue: [ '-']
+					ifFalse: [ '--']), aString.
+	(self arguments includes: option) ifTrue: [ ^ true ].
+	option := option,'='.
+	^ self arguments anySatisfy: [ :arg| arg beginsWith: option ]
+]
+
+{ #category : #testing }
+CommandLineArguments >> includesSubCommand: aName [
+	self withFirstArgument: [ :arg|
+		arg = aName ifTrue: [ ^ true ]].
+	^ false
+]
+
+{ #category : #initialization }
+CommandLineArguments >> initialize [
+
+	| documentPath  |
+
+	arguments := OrderedCollection withAll: Smalltalk arguments.
+	documentPath := Smalltalk vm documentPath.
+	documentPath isEmptyOrNil
+		ifFalse: [ arguments addFirst: documentPath ]
+]
+
+{ #category : #initialization }
+CommandLineArguments >> initializeWithArguments: aCollection [
+	super initialize.
+	arguments := aCollection
+]
+
+{ #category : #testing }
+CommandLineArguments >> longOptionAt: aString [
+	^ self longOptionAt: aString ifAbsent: [
+		Error signal: 'Could not find long-form option: ', aString  ]
+]
+
+{ #category : #testing }
+CommandLineArguments >> longOptionAt: aString ifAbsent: absentBlock [
+	| optionStart |
+	optionStart := '--' , aString , '='.
+	^ self arguments
+		detect: [ :arg | arg beginsWith: optionStart ]
+		ifFound: [ :option | (option splitOn: '=') second ]
+		ifNone: absentBlock
+]
+
+{ #category : #accessing }
+CommandLineArguments >> optionAt: aString [
+	^ self optionAt: aString ifAbsent: [
+		Error signal: 'Could not find option ', aString ]
+]
+
+{ #category : #accessing }
+CommandLineArguments >> optionAt: aString ifAbsent: absentBlock [
+	^ (aString size = 1)
+		ifTrue: [ self shortOptionAt: aString ifAbsent: absentBlock ]
+		ifFalse: [ self longOptionAt: aString ifAbsent: absentBlock ]
+]
+
+{ #category : #accessing }
+CommandLineArguments >> optionAt: aString ifPresent: presentBlock [
+	| option |
+
+	option := self optionAt: aString ifAbsent: [ ^ self ].
+	^ presentBlock value: option
+]
+
+{ #category : #accessing }
+CommandLineArguments >> optionAt: aString ifPresent: presentBlock ifAbsent: absentBlock [
+	| option |
+	option := self optionAt: aString ifAbsent: [ ^ absentBlock value ].
+	^ presentBlock value: option
+]
+
+{ #category : #testing }
+CommandLineArguments >> shortOptionAt: aString [
+	^ self shortOptionAt: aString ifAbsent: [
+		Error signal: 'Could not find short-form option: ', aString  ]
+]
+
+{ #category : #testing }
+CommandLineArguments >> shortOptionAt: aString ifAbsent: absentBlock [
+	| index |
+	index := (arguments indexOf: '-', aString) + 1.
+	^ (index <= 1 or: [ index > arguments size ])
+		ifFalse: [ arguments at: index ]
+		ifTrue: absentBlock
+]
+
+{ #category : #testing }
+CommandLineArguments >> withFirstArgument: aBlock [
+	self arguments ifEmpty: [ ^ self ].
+	^ aBlock value: self arguments first
+]