Posted to tcl by Poor Yorick at Wed Feb 09 18:29:11 GMT 2022view raw

  1. proc waitforstuff {} {
  2. set elapsed [expr {entier(rand() * 2000)}]
  3. after $elapsed [list [info coroutine]]
  4. yield
  5. }
  6.  
  7.  
  8. proc worker {spec body args} {
  9. coroutine [info cmdcount] apply [list $spec $body] {*}$args
  10. }
  11.  
  12.  
  13. proc collect countvar {
  14. upvar $countvar count
  15. lassign [return -level 0 {*}[
  16. yieldto lindex [list [info coroutine]]]] url
  17. return $url
  18. }
  19.  
  20.  
  21. proc done {} {
  22. variable status
  23. puts {Zipped and sent!}
  24. set status 0
  25. }
  26.  
  27.  
  28. proc download {dir url callback} {
  29. worker {dir url callback} {
  30. catch {
  31. puts [list downloading $url]
  32. waitforstuff
  33. set content [list content of $url]
  34. if {$url eq {two}} {
  35. error {not two!}
  36. }
  37. save_file $dir $url $content
  38. lindex $url
  39. } cres copts
  40. dict set copts args [list $dir $url]
  41. {*}$callback -options $copts $cres
  42. } $dir $url $callback
  43. }
  44.  
  45.  
  46. proc downloads {dir urls} {
  47. set length [llength $urls]
  48. foreach url $urls {
  49. after 0 [
  50. list download $dir $url [list [info coroutine]]]
  51. }
  52. set errors {}
  53. while {[incr length -1] >= 0} {
  54. if {[catch {collect length} cres copts]} {
  55. if {[dict exists $copts args]} {
  56. puts [list error on $dir $url]
  57. }
  58. lappend errors $cres $copts
  59. }
  60. }
  61. return
  62. }
  63.  
  64.  
  65. proc save_file {dirvar url content} {
  66. namespace upvar [namespace current] $dirvar dir
  67. puts [list saving to dir $dirvar]
  68. dict set dir $url $content
  69. }
  70.  
  71.  
  72. proc zip dirvar {
  73. namespace upvar [namespace current] $dirvar dir
  74. waitforstuff
  75. foreach {key value} $dir {
  76. puts [list $key $value]
  77. }
  78. }
  79.  
  80.  
  81. proc mail {} {
  82. puts [list mailed stuff]
  83. }
  84.  
  85.  
  86.  
  87. proc main_coro {argv0 argv} {
  88. yield [list [info coroutine]]
  89. set dir mydir
  90. set urls {one two three}
  91. downloads $dir $urls
  92. zip $dir
  93. mail
  94. done
  95. }
  96.  
  97.  
  98. after 0 [coroutine main main_coro $argv0 $argv]
  99.