mercurial/HGCommand.st
branchhg-command-server-support
changeset 232 718711b15cea
parent 231 eb0f01855893
child 233 d9a8bb2aaa0b
equal deleted inserted replaced
231:eb0f01855893 232:718711b15cea
    10  hereby transferred.
    10  hereby transferred.
    11 "
    11 "
    12 "{ Package: 'stx:libscm/mercurial' }"
    12 "{ Package: 'stx:libscm/mercurial' }"
    13 
    13 
    14 Object subclass:#HGCommand
    14 Object subclass:#HGCommand
    15 	instanceVariableNames:'workingDirectory result error workers blocker errors'
    15 	instanceVariableNames:'workingDirectory result error errors blocker errorReader
       
    16 		outputReader'
    16 	classVariableNames:'HGExecutable HGVersion Debugging Tracing'
    17 	classVariableNames:'HGExecutable HGVersion Debugging Tracing'
    17 	poolDictionaries:''
    18 	poolDictionaries:''
    18 	category:'SCM-Mercurial-Internal'
    19 	category:'SCM-Mercurial-Internal'
    19 !
    20 !
    20 
    21 
   456     "Created: / 01-10-2012 / 00:06:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   457     "Created: / 01-10-2012 / 00:06:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   457 ! !
   458 ! !
   458 
   459 
   459 !HGCommand methodsFor:'accessing'!
   460 !HGCommand methodsFor:'accessing'!
   460 
   461 
       
   462 errors
       
   463     ^ errors
       
   464 !
       
   465 
       
   466 result
       
   467     ^ result
       
   468 !
       
   469 
   461 workingDirectory
   470 workingDirectory
   462     ^workingDirectory notNil ifTrue:[
   471     ^workingDirectory notNil ifTrue:[
   463         workingDirectory
   472         workingDirectory
   464     ] ifFalse: [
   473     ] ifFalse: [
   465         Filename currentDirectory pathName
   474         Filename currentDirectory pathName
   514 !HGCommand methodsFor:'executing'!
   523 !HGCommand methodsFor:'executing'!
   515 
   524 
   516 execute
   525 execute
   517     | stdoutPipe stdout stderrPipe stderr pid environment status args spin |
   526     | stdoutPipe stdout stderrPipe stderr pid environment status args spin |
   518 
   527 
   519     workers := OrderedCollection new.
   528     self initialize.
   520     errors := SharedQueue new.
   529     blocker := (Semaphore new:-2) name: 'Waiting for hg command to finish'.
   521 
   530 
   522     stdoutPipe := NonPositionableExternalStream makePipe.
   531     stdoutPipe := NonPositionableExternalStream makePipe.
   523     stdout := stdoutPipe first.
   532     stdout := stdoutPipe first.
   524 
   533 
   525     stderrPipe := NonPositionableExternalStream makePipe.
   534     stderrPipe := NonPositionableExternalStream makePipe.
   539                 do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]
   548                 do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]
   540                 separatedBy: [ s space ]
   549                 separatedBy: [ s space ]
   541         ]
   550         ]
   542     ].
   551     ].
   543 
   552 
   544     blocker := (Semaphore new:-2) name: 'Waiting for hg command to finish'.
   553 
   545     Processor monitor:[
   554     Processor monitor:[
   546         Tracing ifTrue:[
   555         Tracing ifTrue:[
   547             Logger log: 'cmd: executing: ' , (args isString ifTrue:[args] ifFalse:[args asStringWith:' ']) severity: #trace facility: 'HG'.
   556             Logger log: 'cmd: executing: ' , (args isString ifTrue:[args] ifFalse:[args asStringWith:' ']) severity: #trace facility: 'HG'.
   548         ].
   557         ].
   549         pid := OperatingSystem exec:(self executable) withArguments:args
   558         pid := OperatingSystem exec:(self executable) withArguments:args
   570     ].
   579     ].
   571     (Debugging and:[OperatingSystem isUNIXlike]) ifTrue:[
   580     (Debugging and:[OperatingSystem isUNIXlike]) ifTrue:[
   572         stdout := stdout contents asString readStream.
   581         stdout := stdout contents asString readStream.
   573         stderr := stderr contents asString readStream.
   582         stderr := stderr contents asString readStream.
   574     ].
   583     ].
   575     self spawn: [ self parseError:  stderr ].
   584     self spawnErrorReaderOn: stderr.
   576     self spawn: [ result := self parseOutput: stdout ].
   585     self spawnOutputReaderOn: stdout.
   577 
   586 
   578     spin := SemaphoreSet with: blocker with: errors readSemaphore.
   587     spin := SemaphoreSet with: blocker with: errors readSemaphore.
   579 
   588 
   580     [
   589     [
   581         [ spin wait ~~ blocker ] whileTrue:[ self signal ]
   590         [ spin wait ~~ blocker ] whileTrue:[ self signal ]
   587     Tracing ifTrue:[
   596     Tracing ifTrue:[
   588         Logger log: 'returning' severity: #trace facility: 'HG'.
   597         Logger log: 'returning' severity: #trace facility: 'HG'.
   589     ].
   598     ].
   590     ^self status: status result: result
   599     ^self status: status result: result
   591 
   600 
   592     "
       
   593         SVNv2::Command info: 'https://swing.fit.cvut.cz/svn/stx/libsvn'
       
   594     "
       
   595 
       
   596     "Created: / 11-05-2011 / 07:45:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   601     "Created: / 11-05-2011 / 07:45:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   597     "Modified: / 17-12-2011 / 19:22:00 / dundee"
   602     "Modified: / 17-12-2011 / 19:22:00 / dundee"
   598     "Modified (format): / 27-12-2011 / 15:53:54 / dundee"
   603     "Modified (format): / 27-12-2011 / 15:53:54 / dundee"
   599     "Modified: / 14-11-2012 / 13:41:57 / jv"
   604     "Modified: / 14-11-2012 / 13:41:57 / jv"
   600     "Modified (format): / 04-02-2013 / 23:40:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   605     "Modified: / 03-03-2013 / 19:11:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   606 ! !
       
   607 
       
   608 !HGCommand methodsFor:'initialization'!
       
   609 
       
   610 initialize
       
   611     "Invoked when a new instance is created."
       
   612 
       
   613     "/ please change as required (and remove this comment)
       
   614     "/ workingDirectory := nil.
       
   615     "/ result := nil.
       
   616     "/ error := nil.
       
   617     "/ workers := nil.
       
   618     "/ errors := nil.
       
   619 
       
   620     errors := SharedQueue new.
       
   621 
       
   622 
       
   623     "/ super initialize.   -- commented since inherited method does nothing
       
   624 
       
   625     "Modified: / 03-03-2013 / 19:11:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   601 ! !
   626 ! !
   602 
   627 
   603 !HGCommand methodsFor:'private'!
   628 !HGCommand methodsFor:'private'!
   604 
   629 
   605 arguments
   630 arguments
   684 
   709 
   685     "Created: / 04-02-2013 / 12:17:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   710     "Created: / 04-02-2013 / 12:17:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   686     "Modified: / 04-02-2013 / 14:14:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   711     "Modified: / 04-02-2013 / 14:14:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   687 !
   712 !
   688 
   713 
   689 spawn:aBlock
   714 spawn:block name: name
   690     "Spawn a new background thread executing given block"
   715     "Spawn a new background thread executing given block"
   691 
   716 
   692     | worker |
   717     | worker |
   693 
   718 
   694     worker := [ aBlock on: Error do:[:ex|self propagate:ex] ] newProcess.
   719     worker := [ block on: Error do:[:ex|self propagate:ex] ] newProcess.
   695     workers add: worker.
       
   696     worker addExitAction:[
   720     worker addExitAction:[
   697         Tracing ifTrue:[
   721         Tracing ifTrue:[
   698             Logger log: 'command parser finished' severity: #trace facility: 'HG'.
   722             Logger log: 'cmd: worker ''', name , ''' finished' severity: #trace facility: 'HG'.
   699         ].
   723         ].
   700         blocker signal.
   724         blocker notNil ifTrue:[blocker signal].
   701         workers remove: worker
       
   702     ].
   725     ].
   703     worker resume.
   726     worker resume.
   704 
   727     worker name: name.
   705     "Created: / 04-02-2013 / 11:55:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   728     ^worker
   706     "Modified: / 04-02-2013 / 21:59:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   729 
       
   730     "Created: / 03-03-2013 / 16:56:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   731     "Modified: / 03-03-2013 / 19:12:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   732 !
       
   733 
       
   734 spawnErrorReaderOn: stderr
       
   735     errorReader isNil ifTrue:[
       
   736         errorReader := self spawn: [ self parseError:  stderr ] name: 'Error reader'
       
   737     ].
       
   738 
       
   739     "Created: / 03-03-2013 / 16:59:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
   740 !
       
   741 
       
   742 spawnOutputReaderOn: stdout
       
   743     outputReader isNil ifTrue:[    
       
   744         outputReader := self spawn: [ result := self parseOutput: stdout ] name: 'Output reader'.
       
   745     ]
       
   746 
       
   747     "Created: / 03-03-2013 / 17:00:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
   707 !
   748 !
   708 
   749 
   709 status: status result: res
   750 status: status result: res
   710     "Called when hg command finishes, passing it's status and result from parser"
   751     "Called when hg command finishes, passing it's status and result from parser"
   711 
   752