"{ Package: 'stx:libbasic' }"

Object subclass:#CmdLineParser

	instanceVariableNames:'options argv'

	classVariableNames:''

	poolDictionaries:''

	category:'System-Support-Command line'

!

!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

! !