Posted to tcl by Poor Yorick at Wed Feb 09 14:26:04 GMT 2022view raw

  1. proc waitforstuff {} {
  2. set elapsed [expr {1000 * entier(rand() * 2)}]
  3. puts [list elapsed is $elapsed]
  4. after $elapsed [list [info coroutine]]
  5. yield
  6. }
  7.  
  8. proc worker {spec body args} {
  9. coroutine [info cmdcount] apply [list $spec $body] {*}$args
  10. }
  11.  
  12.  
  13. proc collect {count callback} {
  14. worker {count callback} {
  15. while {$count > 0} {
  16. lassign [yieldto lindex [list [info coroutine]]] url
  17. puts [list collected $url]
  18. incr count -1
  19. }
  20. puts [list {finished collecting} calling $callback]
  21. {*}$callback
  22. } $count $callback
  23. }
  24.  
  25.  
  26. proc done {} {
  27. variable status
  28. puts {Zipped and sent!}
  29. set status 0
  30. }
  31.  
  32.  
  33. proc download {dirvar urls callback} {
  34. foreach url $urls {
  35. downloader $dirvar $url $callback
  36. }
  37. }
  38.  
  39.  
  40. proc downloader {dir url callback} {
  41. worker {dir url callback} {
  42. puts [list downloading $url]
  43. waitforstuff
  44. set content [list content of $url]
  45. save_file $dir $url $content
  46. {*}$callback $url
  47. } $dir $url $callback
  48. }
  49.  
  50.  
  51. proc save_file {dirvar url content} {
  52. namespace upvar [namespace current] $dirvar dir
  53. puts [list saving to dir $dirvar]
  54. dict set dir $url $content
  55. }
  56.  
  57.  
  58. proc zip {dirvar callback} {
  59. namespace upvar [namespace current] $dirvar dir
  60. waitforstuff
  61. puts [list zipped contents]
  62. foreach {key value} $dir {
  63. puts [list $key $value]
  64. }
  65. {*}$callback
  66. }
  67.  
  68.  
  69. proc mail callback {
  70. waitforstuff
  71. puts [list mailed stuff]
  72. {*}$callback
  73. }
  74.  
  75.  
  76. proc main_coro {argv0 argv} {
  77. set dir mydir
  78. set urls {one two three}
  79. set collector [collect [llength $urls] [list zip $dir [list mail done]]]
  80. download $dir $urls $collector
  81. }
  82.  
  83.  
  84. after 0 [coroutine main main_coro $argv0 $argv]
  85. vwait status
  86.  
  87.  
  88. if 0 {
  89. proc zipnmail {dir urls} {
  90. set downloads [all [lmap url $urls {
  91. [pgeturl $url] then [lambda {dir url http_state} {
  92. save_file $dir $url [dict get $http_state body]
  93. } $dir $url]
  94. }]]
  95. set zip [$downloads then [lambda {dir dontcare} {
  96. then_chain [pexec zip -r pages.zip $dir]
  97. } $dir]]
  98. set email [$zip then [lambda dontcare {
  99. then_chain [pexec blat pages.zip -to someone@somewhere.com]
  100. }]]
  101. $email done [lambda {dontcare} {
  102. tk_messageBox -message "Zipped and sent!"
  103. }]
  104. }
  105. }
  106.