--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CmdLineOption.st Tue Jun 28 12:54:52 2011 +0200
@@ -0,0 +1,136 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic' }"
+
+Object subclass:#CmdLineOption
+ instanceVariableNames:'action description short long'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Support-Command line'
+!
+
+!CmdLineOption class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+! !
+
+!CmdLineOption methodsFor:'accessing'!
+
+action
+ ^ action
+
+ "Created: / 28-01-2009 / 11:49:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+action:aBlockOrMessageSend
+
+ aBlockOrMessageSend numArgs > 1 ifTrue:
+ [CmdLineOptionError raiseErrorString: 'Action must be zero-or-one arg block/message send'].
+ action := aBlockOrMessageSend.
+
+ "Created: / 28-01-2009 / 11:49:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 16-06-2009 / 15:46:54 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+description
+ ^ description
+
+ "Created: / 28-01-2009 / 11:49:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+description:aString
+ description := aString.
+
+ "Created: / 28-01-2009 / 11:49:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+long
+ ^ long
+!
+
+long:aString
+ long := aString.
+!
+
+short
+ ^ short
+!
+
+short:aCharacterOrString
+
+ (aCharacterOrString isCharacter
+ and:[aCharacterOrString isAlphaNumeric])
+ ifTrue:[short := aCharacterOrString]
+ ifFalse:[self error: 'short option name should be alphanumeric character']
+
+ "Modified: / 29-05-2009 / 16:05:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineOption methodsFor:'printing & storing'!
+
+printOn: stream
+
+ super printOn: stream.
+ stream nextPut:$(.
+ short ifNotNil:[stream nextPut: $-; nextPut: short].
+ (short notNil and: [long notNil]) ifTrue:[stream nextPut:$|].
+ long ifNotNil:[stream nextPut: $-; nextPut: $-; nextPutAll: long].
+ stream nextPut:$)
+
+ "Created: / 08-06-2009 / 14:48:59 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineOption methodsFor:'processing'!
+
+process
+
+ action value
+
+ "Created: / 08-06-2009 / 14:35:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+process: value
+
+ action value: value
+
+ "Created: / 08-06-2009 / 14:35:08 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineOption methodsFor:'queries'!
+
+hasParam
+
+ ^action numArgs = 1
+
+ "Created: / 08-06-2009 / 13:45:41 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineOption class methodsFor:'documentation'!
+
+version
+ ^'$Id: CmdLineOption.st,v 1.1 2011-06-28 10:54:52 vrany Exp $'
+!
+
+version_SVN
+ ^ '$Id: CmdLineOption.st,v 1.1 2011-06-28 10:54:52 vrany Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CmdLineOptionError.st Tue Jun 28 12:54:52 2011 +0200
@@ -0,0 +1,45 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic' }"
+
+Error subclass:#CmdLineOptionError
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Support-Command line'
+!
+
+!CmdLineOptionError class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+! !
+
+!CmdLineOptionError class methodsFor:'documentation'!
+
+version
+ ^'$Id: CmdLineOptionError.st,v 1.1 2011-06-28 10:54:52 vrany Exp $'
+!
+
+version_SVN
+ ^ '$Id: CmdLineOptionError.st,v 1.1 2011-06-28 10:54:52 vrany Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CmdLineParser.st Tue Jun 28 12:54:52 2011 +0200
@@ -0,0 +1,284 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic' }"
+
+Object subclass:#CmdLineParser
+ instanceVariableNames:'options argv'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Support-Command line'
+!
+
+!CmdLineParser class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+! !
+
+!CmdLineParser class methodsFor:'parsing'!
+
+parse: argv for: object
+
+ ^self new parse: argv for: object
+
+ "Created: / 28-01-2009 / 12:06:04 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineParser methodsFor:'accessing'!
+
+args
+ ^ argv
+!
+
+args:aCollection
+
+ argv := aCollection
+
+ "Modified: / 08-06-2009 / 13:24:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+cmdlineOptionHelp
+
+ ^CmdLineOption new
+ short: $a;
+ long: 'help';
+ description: 'Prints short summary of available options';
+ action:[self printHelp]
+
+ "Created: / 08-06-2009 / 14:54:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+options
+ ^ options
+!
+
+options:something
+ options := something.
+! !
+
+!CmdLineParser methodsFor:'error reporting'!
+
+error: message option: option
+
+ <resource: #skipInDebuggerWalkback>
+
+ ^CmdLineOptionError new
+ errorString: message;
+ parameter: option;
+ raise
+
+ "Created: / 08-06-2009 / 14:22:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+errorOptionHasNoArgument:option
+ self error:'option has no argument' option:option
+
+ "Created: / 08-06-2009 / 14:27:49 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+errorOptionRequiresArgument:option
+ self error:'option requires an argument' option:option
+! !
+
+!CmdLineParser methodsFor:'initialization'!
+
+collectOptionsFrom: anObject
+
+ options := anObject class allSelectors
+ select:[:sel|sel startsWith: 'cmdlineOption']
+ thenCollect:[:sel|anObject perform: sel].
+
+ "Created: / 08-06-2009 / 13:06:23 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineParser methodsFor:'parsing'!
+
+parse
+ "
+ Parses argv array. Returns array of unparsed (i.e. non-option)
+ arguments
+ "
+
+ | i |
+ i := 1.
+ [i <= argv size] whileTrue:
+ [|arg option |
+ arg := argv at:i.
+ "arg is not an option"
+ arg first ~= $-
+ ifTrue:
+ [^argv copyFrom: i].
+ i := self parseArg: i].
+ ^#()
+
+ "Created: / 08-06-2009 / 13:26:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 08-06-2009 / 14:38:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+parse:aCollection
+ "
+ Parses argv array. Returns array of unparsed (i.e. non-option)
+ arguments
+ "
+
+ ^self
+ args: aCollection;
+ parse.
+
+ "Created: / 28-01-2009 / 12:08:29 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 08-06-2009 / 13:26:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+parse: argv for: object
+
+ "
+ Parses argv array. Returns array of unparsed (i.e. non-option)
+ arguments. Options are obtained from given object
+ "
+
+ ^self
+ collectOptionsFrom: object;
+ parse: argv
+
+ "Created: / 28-01-2009 / 11:50:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 08-06-2009 / 13:07:59 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+parse:argv options: opts
+
+ "
+ Parses argv array. Returns array of unparsed (i.e. non-option)
+ arguments. Options are obtained from given object
+ "
+
+ options := opts.
+ ^self parse: argv
+
+ "Created: / 29-05-2009 / 15:51:41 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 08-06-2009 / 13:08:12 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineParser methodsFor:'printing & storing'!
+
+printHelp
+
+ ^self printHelpOn: Stdout
+
+ "Created: / 08-06-2009 / 14:55:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+printHelpOn: stream
+
+ stream nextPutAll:'help...'; cr.
+
+ "Created: / 08-06-2009 / 14:56:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineParser methodsFor:'private'!
+
+optionByLong:longName
+ ^ options
+ detect:[:option | option long = longName ]
+ ifNone:[
+ longName = 'help'
+ ifTrue:[self cmdlineOptionHelp]
+ ifFalse:[CmdLineOptionError raiseErrorString:'Unknown option: ' , longName ]]
+
+ "Created: / 30-01-2009 / 09:15:24 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 08-06-2009 / 14:57:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+optionByShort:shortName
+ ^ options
+ detect:[:option | option short = shortName ]
+ ifNone:
+ [ shortName = $h
+ ifTrue:[self cmdlineOptionHelp]
+ ifFalse:[CmdLineOptionError raiseErrorString:'Unknown option: ' , shortName ]]
+
+ "Created: / 30-01-2009 / 09:16:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 08-06-2009 / 14:58:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+parseArg:index
+ "
+ Parses arg at index. Returns an index of
+ next arg to be parsed."
+
+ |arg option param|
+
+ arg := argv at:index.
+ arg second ~= $-
+ ifTrue:
+ ["/ short option or bunch of those
+ 2 to:arg size do:[:subIndex |
+ option := self optionByShort:(arg at:subIndex).
+ option ifNotNil:
+ [option hasParam
+ ifFalse:[option process]
+ ifTrue:
+ ["Do additional check, if this short option
+ is last."
+ ((subIndex ~= arg size) or:[ (argv size) < (index + 1) ]) ifTrue:[
+ self errorOptionRequiresArgument:option
+ ].
+ param := (argv at:index + 1).
+ option process:param.
+ ^ index + 2
+ ]]].
+ ^ index + 1]
+ ifFalse:
+ ["/ long option starting with --
+ | equalPos |
+
+ (equalPos := arg indexOf:$=) == 0 ifTrue:[
+ "/no arg specified
+ (option := self optionByLong:(arg copyFrom:3))
+ ifNotNil:[
+ option hasParam ifTrue:[self errorOptionRequiresArgument:option].
+ option process].
+ ^index + 1.
+ ] ifFalse: [
+ option := self optionByLong:(arg copyFrom:3 to: equalPos - 1).
+ param := arg copyFrom: equalPos + 1.
+ option ifNotNil:
+ [option hasParam
+ ifTrue:
+ [option process: param]
+ ifFalse:
+ [self errorOptionHasNoArgument: option]]
+ ].
+ ^index + 2
+ ]
+
+ "Created: / 08-06-2009 / 14:38:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineParser class methodsFor:'documentation'!
+
+version
+ ^'$Id: CmdLineParser.st,v 1.1 2011-06-28 10:54:52 vrany Exp $'
+!
+
+version_SVN
+ ^ '$Id: CmdLineParser.st,v 1.1 2011-06-28 10:54:52 vrany Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CmdLineParserTest.st Tue Jun 28 12:54:52 2011 +0200
@@ -0,0 +1,185 @@
+"{ Package: 'stx:libbasic' }"
+
+TestCase subclass:#CmdLineParserTest
+ instanceVariableNames:'optionA optionB optionBValue'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Support-Command line'
+!
+
+
+!CmdLineParserTest methodsFor:'accessing'!
+
+cmdlineOptionA
+
+ ^CmdLineOption new
+ short: $a;
+ long: 'option-a';
+ description: 'option a with no arg';
+ action:[optionA := true]
+
+ "Created: / 28-01-2009 / 11:56:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 08-06-2009 / 14:34:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+cmdlineOptionB
+
+ ^CmdLineOption new
+ short: $b;
+ long: 'option-b';
+ description: 'option b with one arg';
+ action:[:value | optionB := true. optionBValue := value]
+
+ "Created: / 28-01-2009 / 12:01:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 08-06-2009 / 14:33:50 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineParserTest methodsFor:'initialization'!
+
+setUp
+
+ optionA := optionB := false.
+ optionBValue := nil
+
+ "Created: / 28-01-2009 / 12:01:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineParserTest methodsFor:'tests'!
+
+test_01
+
+ CmdLineParser
+ parse: #('-a')
+ for: self.
+
+ self assert: optionA.
+ self deny: optionB.
+
+ "Created: / 28-01-2009 / 14:19:18 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 29-05-2009 / 15:47:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+test_02
+
+ CmdLineParser
+ parse: #('--option-a')
+ for: self.
+
+ self assert: optionA.
+ self deny: optionB.
+
+ "Created: / 28-01-2009 / 14:19:38 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 29-05-2009 / 15:47:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+test_04a
+
+ CmdLineParser
+ parse: #('--option-b= value')
+ for: self.
+
+ self deny: optionA.
+ self assert: optionB.
+ self assert: optionBValue = ' value'
+
+ "Created: / 30-01-2009 / 10:43:40 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 29-05-2009 / 15:47:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+test_04b
+
+ self
+ should:[CmdLineParser parse: #('--option-b') for: self]
+ raise: CmdLineOptionError
+
+ "Created: / 30-01-2009 / 10:43:37 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 29-05-2009 / 15:47:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+test_04c
+
+ CmdLineParser parse: #('--option-b=') for: self.
+
+ self deny: optionA.
+ self assert: optionB.
+ self assert: optionBValue = ''
+
+ "Created: / 30-01-2009 / 10:44:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 29-05-2009 / 15:47:44 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+test_05
+
+ CmdLineParser
+ parse: #('-b' 'value')
+ for: self.
+
+ self deny: optionA.
+ self assert: optionB.
+ self assert: optionBValue = 'value'.
+
+ "Created: / 03-02-2009 / 17:38:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 29-05-2009 / 15:47:50 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+test_06
+
+ CmdLineParser
+ parse: #('-a' '-b' 'value')
+ for: self.
+
+ self assert: optionA.
+ self assert: optionB.
+ self assert: optionBValue = 'value'.
+
+ "Created: / 03-02-2009 / 17:39:54 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 29-05-2009 / 15:47:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+test_07
+
+ CmdLineParser
+ parse: #('-ab' 'value')
+ for: self.
+
+ self assert: optionA.
+ self assert: optionB.
+ self assert: optionBValue = 'value'.
+
+ "Created: / 03-02-2009 / 17:40:04 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 29-05-2009 / 15:48:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+test_08
+
+ | rest |
+ rest := CmdLineParser
+ parse: #('-a' '/tmp/abc.txt')
+ for: self.
+
+ self assert: optionA.
+ self assert: optionB not.
+ self assert: rest asArray = #('/tmp/abc.txt')
+
+ "Created: / 08-06-2009 / 14:51:54 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+test_09
+
+ | rest |
+ rest := CmdLineParser
+ parse: #('/tmp/abc.txt')
+ for: self.
+
+ self assert: optionA not.
+ self assert: optionB not.
+ self assert: rest asArray = #('/tmp/abc.txt')
+
+ "Created: / 08-06-2009 / 14:52:13 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!CmdLineParserTest class methodsFor:'documentation'!
+
+version
+ ^'$Id: CmdLineParserTest.st,v 1.1 2011-06-28 10:54:52 vrany Exp $'
+! !