Posted to tcl by Poor Yorick at Thu Feb 10 11:06:53 GMT 2022view raw

  1. proc done {} {
  2. variable status
  3. puts {Zipped and sent!}
  4. set status 0
  5. }
  6.  
  7.  
  8. proc download {dir url} {
  9. puts [list downloading $url]
  10. waitforstuff
  11. set content [list content of $url]
  12. if {$url eq {two}} {
  13. error {not two!}
  14. }
  15. save_file $dir $url $content
  16. lindex $url
  17. }
  18.  
  19.  
  20. proc downloaderror {cres copts} {
  21. set msg [list {error downloading} $cres]
  22. if {[dict exists $copts task]} {
  23. lappend msg task [dict get $copts task]]
  24. }
  25. puts stderr $msg
  26. }
  27.  
  28.  
  29. proc downloads {dir urls err} {
  30. set length [llength $urls]
  31. set tasks [lmap url $urls {
  32. list download $dir $url
  33. }]
  34. parallel $tasks err $err
  35. return
  36. }
  37.  
  38.  
  39. proc downloadzipandmail {dir urls} {
  40. downloads $dir $urls downloaderror
  41. zip $dir
  42. mail
  43. done
  44. }
  45.  
  46.  
  47. proc du {} {
  48. waitforstuff
  49. return {disk size done}
  50. }
  51.  
  52.  
  53. proc errhandler {cres copts} {
  54. puts [list {got this error} $cres]
  55. if {[dict exists $copts task]} {
  56. puts [list {error task} [dict get $copts task]]
  57. }
  58. }
  59.  
  60.  
  61. proc mail {} {
  62. puts [list mailed stuff]
  63. }
  64.  
  65.  
  66. proc parallel {tasks args} {
  67. while {[llength $args]} {
  68. set args [lassign $args[set args {}] arg]
  69. switch $arg {
  70. err {
  71. set args [lassign $args[set args {}] err]
  72. puts [list bugga $err]
  73. }
  74. default {
  75. error [list {unknown argument} $arg]
  76. }
  77. }
  78. }
  79. set length [llength $tasks]
  80. foreach task $tasks {
  81. after 0 [
  82. list worker proxy $task [list [info coroutine]]]
  83. }
  84. while {[incr length -1] >= 0} {
  85. if {[catch {return {*}[
  86. yieldto lindex [list [info coroutine]]]
  87. } cres copts]} {
  88. if {[info exists err]} {
  89. {*}$err $cres $copts
  90. }
  91. return -options $copts $cres
  92. }
  93. }
  94. }
  95.  
  96.  
  97. proc proxy {task return} {
  98. catch $task cres copts
  99. dict set copts task $task
  100. {*}$return -options $copts $cres
  101. }
  102.  
  103.  
  104. proc save_file {dirvar url content} {
  105. namespace upvar [namespace current] $dirvar dir
  106. puts [list saving to dir $dirvar]
  107. dict set dir $url $content
  108. }
  109.  
  110.  
  111. proc zip dirvar {
  112. namespace upvar [namespace current] $dirvar dir
  113. waitforstuff
  114. foreach {key value} $dir {
  115. puts [list $key $value]
  116. }
  117. }
  118.  
  119.  
  120. proc waitforstuff {} {
  121. set elapsed [expr {entier(rand() * 2000)}]
  122. after $elapsed [list [info coroutine]]
  123. yield
  124. }
  125.  
  126.  
  127. proc worker args {
  128. coroutine [info cmdcount] {*}$args
  129. }
  130.  
  131.  
  132. proc main_coro {argv0 argv} {
  133. yield [list [info coroutine]]
  134. set dir mydir
  135. set urls {one two three}
  136. parallel [list [list downloadzipandmail $dir $urls] du] err errhandler
  137. }
  138.  
  139.  
  140. after 0 [coroutine main main_coro $argv0 $argv]
  141. vwait status
  142.