Posted to tcl by pooryorick at Wed Nov 13 19:39:52 GMT 2013view raw

  1. #! /bin/env tclsh
  2.  
  3. proc invoke {command handler} {
  4. lassign [chan pipe] stderr stderrin
  5. lappend command 2>@$stderrin
  6. set stdout [open |$command]
  7.  
  8. set handler1 [namespace current]::[info cmdcount]
  9. coroutine $handler1 {*}$handler
  10. fileevent $stderrin writable [list apply {{stdout stderrin} {
  11. if {[chan names $stdout] eq {} || [eof $stdout]} {
  12. close $stderrin
  13. }
  14. }} $stdout $stderrin]
  15. fileevent $stdout readable [list $handler1 [list stdout $stdout]]
  16. fileevent $stderr readable [list $handler1 [list stderr $stderr]]
  17. }
  18.  
  19.  
  20. proc handler {onstdout onstderr onexit} {
  21. set done {}
  22. lassign [yield [info level 0]] mode chan
  23. while 1 {
  24. if {[set data [gets $chan]] eq {}} {
  25. if {[eof $chan]} {
  26. lappend done $mode
  27. if {[catch {close $chan} cres e]} {
  28. dict with e {}
  29. lassign [set -errorcode] sysmsg pid exit
  30. if {$sysmsg == "NONE"} {
  31. #output to stderr caused [close] to fail. Do nothing
  32. } elseif {$sysmsg eq "CHILDSTATUS"} {
  33. {*}$onexit $exit
  34. } else {
  35. return -options $e $stderr
  36. }
  37. }
  38. if {[llength $done] == 2} {
  39. return
  40. } else {
  41. lassign [yield] mode chan
  42. }
  43. } else {
  44. lassign [yield] mode chan
  45. }
  46. } else {
  47. {*}[set on$mode] $data
  48. lassign [yield] mode chan
  49. }
  50. }
  51. }
  52.  
  53.  
  54.  
  55. set command {
  56. puts stdout {hi to stdout}
  57. puts stderr {hi to stderr}
  58. exit 42
  59. }
  60.  
  61. invoke [list tclsh <<$command] [list handler [list apply {{data} {
  62. puts -nonewline "here comes some stdout: "
  63. puts $data
  64. }}] [list apply {{data} {
  65. puts -nonewline "here comes some stderr: "
  66. return -code error "an error!"
  67. puts $data
  68. }}] [list apply {{code} {
  69. set ::exit 1
  70. puts $code
  71. }}]]
  72.  
  73.  
  74.  
  75. vwait exit
  76.