"{ Package: 'stx:libscm/mercurial' }"

Object subclass:#HGCommandParser

	instanceVariableNames:'stream'

	classVariableNames:''

	poolDictionaries:''

	category:'SCM-Mercurial-Internal'

!

!HGCommandParser class methodsFor:'instance creation'!

on: aStringOrStream

    | stream |

    stream := aStringOrStream isStream 

                ifTrue:[aStringOrStream]

                ifFalse:[aStringOrStream readStream].

    ^self new stream: stream

    "Created: / 23-10-2012 / 11:07:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-11-2012 / 16:36:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandParser class methodsFor:'templates'!

templateHeads

    ^'{rev}:{node}\n'

    "Created: / 27-11-2012 / 21:25:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

templateLog

    ^

'{rev}:{node}

{branch}

{parents}

{file_adds}

{file_copies}

{file_dels}

{file_mods}

{author}

{date|isodate}

{desc}

**EOE**

'

    "Created: / 12-11-2012 / 23:06:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 05-12-2012 / 23:32:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

templateLogChildren

    ^'{rev}:{node}\n{children}\n'

    "Created: / 05-12-2012 / 23:40:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

templateLogFile

    ^'{rev}:{node}\n'

    "Created: / 05-12-2012 / 19:10:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandParser methodsFor:'accessing'!

stream

    ^ stream

!

stream:something

    stream := something.

! !

!HGCommandParser methodsFor:'error reporting'!

error: aString

    <context: #return>

    <resource: #skipInDebuggersWalkBack>

    HGCommandParseError raiseWith:#error: errorString:aString

    "Created: / 14-11-2012 / 19:59:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandParser methodsFor:'parsing'!

parseBranches

    "Parse output of 'hg branches' command. Return collection

     of orphaned HGBranch"

    | branches |

    branches := OrderedCollection new.

    [ stream atEnd ] whileFalse:[

        branches add: self parseBranchesEntry

    ].

    ^branches

    "Created: / 27-11-2012 / 20:20:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseBranchesEntry

    | branch |

    branch := HGBranch new.

    branch setName: self parseName.

    stream skipSeparators.

    self parseNodeId.

    stream peek == Character space ifTrue:[

        stream next.

        stream peek == $( ifFalse:[self error:'''('' expected but ''' , stream peek , ''' found'].

        stream next.

        stream peek == $i ifTrue:[

            self expect:'inactive)'.

            branch setActive: false.

        ] ifFalse:[

            stream peek == $c ifTrue:[

                self expect:'closed)'.

                branch setClosed: true.

            ] ifFalse:[

                self error:'Unexpected branch attribute (only ''closed'' and ''inactive'' supported)'''

            ]

        ].

    ].

    self expectLineEnd.

    ^branch

    "Created: / 27-11-2012 / 19:23:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseConfig

    "Parse output of 'hg showconfig' command, assuming the template given

     was HGCommandParser templateLog. Return a list of HGChangeset."

    | root |

    root := HGConfig::Section new setName: '<root>'.

    [ stream atEnd ] whileFalse:[

        self parseConfigEntryInto: root.

    ].

    ^root

    "Created: / 06-12-2012 / 16:00:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-12-2012 / 19:59:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseConfigEntryInto: root

    | entry out |

    entry := root.

    out := String new writeStream.

    [ stream atEnd or:[stream peek == $=] ] whileFalse:[

        stream peek == $. ifTrue:[

            entry := entry at: out contents ifAbsentPut: [

                HGConfig::Section new setName: out contents.

            ].

            out reset.

            stream next.

        ] ifFalse:[

            out nextPut: stream next.

        ].

    ].

    stream next.

    entry at: out contents put:

        (HGConfig::Entry new setName: out contents value:stream nextLine)

    "Created: / 06-12-2012 / 19:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseDate

    | ts |

    ts := Timestamp readIso8601FormatFrom:stream.

    (stream peek == $+ or:[stream peek == $-]) ifFalse:[

        self error:'Timezone expected, ' , stream peek , ' found'

    ].

    stream next.

    4 timesRepeat:[

        ('0123456789' includes: stream peek) ifFalse:[

            self error:'Timezone expected, ' , stream peek , ' found'

        ].

        stream next.

    ].

    ^ts

    "Created: / 13-11-2012 / 10:22:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-11-2012 / 17:28:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseInteger

    "Parses integer from stream and returns it"

    ^Integer readFrom: stream onError:[self error: 'integer value expected']

    "

    (HGCommandParser on: '12 34' readStream) parseInteger; skipSeparators; parseInteger

    "

    "Created: / 19-11-2012 / 20:05:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseLog

    "Parse output of 'hg log' command, assuming the template given

     was HGCommandParser templateLog. Return a list of HGRevision."

    | revs |

    revs := OrderedCollection new.

    [ stream atEnd ] whileFalse:[

        | rev |

        rev := self parseLogEntry.

        revs add: rev.

    ].

    ^revs.

    "Created: / 13-11-2012 / 09:46:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseLogEntry

    "Parse single revision entry, assuming the template given

     was HGCommandParser templateLog. Return a HGRevision."

    | rev branches line message adds copies deletions modifications |

    rev := HGChangeset new.

    rev setId: self parseNodeId. self expectLineEnd.

    branches := self parseNameList. self expectLineEnd.

    rev setBranches: branches.

    rev setParent1Id: self parseNodeId. self expectSpace.

    rev setParent2Id: self parseNodeId. self expectSpace. self expectLineEnd.

    "rev setChildren: self parseNodeIdList." self expectLineEnd.

    adds := self parsePathList. self expectLineEnd.

    copies := self parsePathCopyList. self expectLineEnd.

    deletions := self parsePathList. self expectLineEnd.

    modifications := self parsePathList. self expectLineEnd.

    copies pairsDo:[:dst :src|

        adds remove: dst.

        deletions remove: src.

    ].

    adds := adds collect:[:e|HGChange newAdded setChangeset: rev path: e].

    copies := copies collect:[:e|HGChange newCopied setChangeset: rev path: e first; setSource: e second].

    deletions := deletions collect:[:e|HGChange newRemoved setChangeset: rev path: e].

    modifications := modifications collect:[:e|HGChange newModified setChangeset: rev path: e].

    rev setChanges: modifications , adds , deletions , copies.

    rev setAuthor: self nextLine.

    rev setTimestamp: self parseDate. self expectLineEnd.

    message := String streamContents:[:s|

        line := self nextLine.

        s nextPutAll: line.

        [ line := self nextLine . line = '**EOE**' ] whileFalse:[

            s cr.

            s nextPutAll: line

        ].

    ].

    rev setMessage: message.

    rev setNonLazy.

    ^rev

    "Created: / 13-11-2012 / 09:45:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-12-2012 / 00:38:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseName

    ^String streamContents:[:out|

        [ stream peek isSeparator ] whileFalse:[

            out nextPut:stream next

        ]

    ].

    "Created: / 27-11-2012 / 20:21:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseNameList

    | list |

    stream atEnd ifTrue:[ ^#() ].

    stream peek isSeparator ifTrue:[ ^#() ].

    list := OrderedCollection new.

    list add: self parseName.

    [ stream atEnd not and:[stream peek == Character space]] whileTrue:[

        stream next. "/eat space.

        list add: self parseName.

    ].

    ^list.

    "Created: / 27-11-2012 / 20:30:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseNodeId

    "Parses node id from stream and returns it. Support both,

     short and full node ids"

    ^HGChangesetId readFrom: stream onError:[:msg|self error: msg]

    "

        (HGCommandParser on: '4:6f88e1f44d9eb86e0b56ca15e30e5d786acd83c7' readStream) parseNodeId

        Bad ones:

        (HGCommandParser on: '4:6f88e1f44d9eb86e0b56ca15e30e5d786acd' readStream) parseNodeId

        (HGCommandParser on: '4:6f88Z1f44d9eb86e0b56ca15e30e5d786acd83c7' readStream) parseNodeId

    "

    "Created: / 13-11-2012 / 10:22:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-11-2012 / 16:52:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseNodeIdList

    "Parses node id list from stream and returns it. Support both,

     short and full node ids."

    | ids |

    stream atEnd ifTrue:[ ^ #() ].

    stream peek == Character cr ifTrue:[ ^ #() ].

    ids := OrderedCollection new.

    [ stream peek ~~ Character cr ] whileTrue:[

        ids add: self parseNodeId.

        stream peek == Character space ifTrue:[stream next].

    ].

    ^ids

    "Created: / 05-12-2012 / 17:24:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parsePath

    "Parse single path entry from repository"

    ^self parseName

    "Created: / 05-12-2012 / 18:27:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parsePathCopy

    "Parse single path entry from repository"

    | dst src |

    dst := self parseName.

    self expectSpace.

    self expect:$(.

    src := String streamContents:[:out|

        [ stream peek == $) ] whileFalse:[

            out nextPut:stream next

        ].

        stream next.

    ].

    ^Array with: dst with: src

    "Created: / 05-12-2012 / 18:38:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parsePathCopyList

    | list |

    stream atEnd ifTrue:[ ^#() ].

    stream peek isSeparator ifTrue:[ ^#() ].

    list := OrderedCollection new.

    list add: self parsePathCopy.

    [ stream atEnd not and:[stream peek ~= Character cr]] whileTrue:[

        "/stream next. "/eat space.

        list add: self parsePathCopy.

    ].

    ^list.

    "Created: / 05-12-2012 / 18:39:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 10-01-2013 / 23:25:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parsePathList

    | list |

    stream atEnd ifTrue:[ ^#() ].

    stream peek isSeparator ifTrue:[ ^#() ].

    list := OrderedCollection new.

    list add: self parsePath.

    [ stream atEnd not and:[stream peek == Character space]] whileTrue:[

        stream next. "/eat space.

        list add: self parsePath.

    ].

    ^list.

    "Created: / 05-12-2012 / 18:27:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parsePushLine

    | first rest |

    first := stream upToSeparator.

    first = 'adding' ifTrue:[

        ActivityNotification notify: first, ' ' , stream nextLine.

    ].

    first = 'added' ifTrue:[

        ActivityNotification notify: first, ' ' , stream nextLine.

    ].

    first = 'abort:' ifTrue:[

        rest := stream nextLine.

        (rest startsWith: ' push creates new remote head') ifTrue:[

            HGPushWouldCreateNewHeadError raiseErrorString: rest.

            ^self.

        ].

        HGPushError raiseErrorString: rest.

    ]

    "Created: / 10-12-2012 / 02:24:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandParser methodsFor:'parsing - commands'!

parseCommandBranches

    "Parse output of 'hg branches' command. Return collection

     of orphaned HGBranch"

    ^self parseBranches

    "Created: / 27-11-2012 / 19:16:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 27-11-2012 / 20:21:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseCommandHeads

    "Parse output of 'hg heads' command, assuming the template given

     was HGCommandParser templateHeads. Return a list of HGChangesetId."

    | ids |

    ids := OrderedCollection new.

    [ stream atEnd ] whileFalse:[

        ids add: self parseNodeId. self expectLineEnd.

    ].

    ^ids

    "Created: / 27-11-2012 / 21:24:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseCommandLocate

    "Filenames are 0-byte separated. Yeah, Mercurial is easy

     to parse"

    | filenames |

    filenames := OrderedCollection new.

    [ stream atEnd ] whileFalse:[