BT.AutoUpdate.tcl 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631
  1. #########################################################################
  2. ## BlackTools - The Ultimate Channel Control Script ##
  3. ## One TCL. One smart Eggdrop ##
  4. #########################################################################
  5. ######################### AutoUpdate TCL ############################
  6. #########################################################################
  7. ## ##
  8. ## BlackTools : http://blacktools.tclscripts.net ##
  9. ## Bugs report : http://www.tclscripts.net/ ##
  10. ## GitHub page : https://github.com/tclscripts/BlackToolS-TCL ##
  11. ## Online Help : irc://irc.undernet.org/tcl-help ##
  12. ## #TCL-HELP / UnderNet ##
  13. ## You can ask in english or romanian ##
  14. ## ##
  15. #########################################################################
  16. package require tls
  17. set black(backup_dir) "$black(dirname)/BT.backup"
  18. set black(log_file) "$black(dirname)/BT.update.log"
  19. set black(actdir) "scripts"
  20. ###
  21. proc blacktools:check_addons {hand chan} {
  22. global black
  23. if {[catch {package require http} no_http] != 0} {
  24. source $black(dirname)/BlackTools/Addons/http.tcl
  25. package require http
  26. }
  27. if {[catch {package require json} no_json] != 0} {
  28. source $black(dirname)/BlackTools/Addons/json.tcl
  29. package require json
  30. }
  31. if {[catch {package require github} no_github] != 0} {
  32. source $black(dirname)/BlackTools/Addons/github.tcl
  33. package require github
  34. }
  35. return 1
  36. }
  37. ###
  38. proc blacktools:update_check {nick hand host chan type} {
  39. global black
  40. set check_addons [blacktools:check_addons $hand $chan]
  41. set status [blacktools:update_verify]
  42. if {$status == -1} {
  43. blacktools:update_put $hand $chan 31 ""
  44. blacktools:tell $nick $host $hand $chan $chan autoupdate.31 ""
  45. return 0
  46. }
  47. set data [split $status "\n"]
  48. set new_version [lindex [lindex $data 0] 1]
  49. set last_modify [lindex [lindex $data 1] 2]
  50. set status [lindex [lindex $data 2] 1]
  51. if {$black(vers) != $new_version} {
  52. if {$type == 0} {
  53. blacktools:tell $nick $host $hand $chan $chan autoupdate.32 "$new_version"
  54. } else {
  55. return [list $new_version $last_modify]
  56. }
  57. } elseif {$last_modify != $black(current_modif)} {
  58. if {$type == 0} {
  59. blacktools:tell $nick $host $hand $chan $chan autoupdate.33 [ctime $last_modify]
  60. }
  61. return [list $new_version $last_modify]
  62. } else {
  63. if {$type == 0} {
  64. blacktools:tell $nick $host $hand $chan $chan autoupdate.5 ""
  65. }
  66. return 0
  67. }
  68. }
  69. ###
  70. proc blacktools:update:timer {} {
  71. global black
  72. if {$black(update_type) == 0} {
  73. if {![info exists black(update_disabled)]} {
  74. if {![info exists black(backup_update)]} {
  75. set update [catch {blacktools:update "" "" ""} error]
  76. } else {
  77. blacktools:update_put "" "" 40 ""
  78. }
  79. } else {
  80. blacktools:update_put "" "" 27 [list [ctime [unixtime]]]
  81. blacktools:update_put "" "" 30 [list $black(update_disabled)]
  82. }
  83. } else {
  84. if {$black(update_note) == 1} {
  85. if {![info exists black(update_disabled)]} {
  86. set check [blacktools:update_check "" "" "" "" 1]
  87. if {$check != 0} {
  88. set found_version [lindex $check 0]
  89. set last_modif [lindex $check 1]
  90. blacktools:update:note $last_modif $found_version
  91. }
  92. }
  93. }
  94. }
  95. timer [time_return_minute $black(update_time_check)] blacktools:update:timer
  96. }
  97. ###
  98. proc blacktools:update:note {num version} {
  99. global black botnick
  100. set time [unixtime]
  101. foreach user [userlist n] {
  102. set nonotes [getuser $user XTRA NO_NOTES]
  103. if {$nonotes == ""} {
  104. set check_note [blacktools:update_note_check $user $num]
  105. if {$check_note == 1} {continue}
  106. set getlang [string tolower [getuser $user XTRA OUTPUT_LANG]]
  107. if {$getlang == ""} { set getlang "[string tolower $black(default_lang)]" }
  108. set black(notes:announce:$user) 1
  109. set replace(%msg.1%) $version
  110. set replace(%msg.2%) [ctime $num]
  111. set text [black:color:set $botnick $black(say.$getlang.autoupdate.43)]
  112. set text [string map [array get replace] $text]
  113. notes:add $botnick "" $user "DB" "INBOX" $text "AUTOUPDATE:$num" 0
  114. }
  115. }
  116. }
  117. ###
  118. proc blacktools:update_note_check {hand num} {
  119. global black
  120. set found_it 0
  121. set file [open $black(notes_file) "r"]
  122. while {[gets $file line] != -1} {
  123. set handle [lindex [split $line] 4]
  124. if {[string equal -nocase $handle $hand]} {
  125. set sender [lindex [split $line] 6]
  126. set split_send [split $sender ":"]
  127. set last_update [lindex $split_send 1]
  128. set sender [lindex $split_send 0]
  129. if {[string equal -nocase $sender "AUTOUPDATE"] && [string equal -nocase $num $last_update]} {
  130. set found_it 1
  131. break
  132. }
  133. }
  134. }
  135. close $file
  136. return $found_it
  137. }
  138. ###
  139. proc blacktools:update {hand host chan} {
  140. global black
  141. if {[info exists black(backup_update)]} {
  142. blacktools:update_put $hand $chan 29 ""
  143. return 0
  144. }
  145. set error_b ""
  146. set file [open $black(log_file) w]
  147. close $file
  148. blacktools:update_put $hand $chan 27 [list [ctime [unixtime]]]
  149. blacktools:update_put $hand $chan 28 ""
  150. set check_addons [blacktools:check_addons $hand $chan]
  151. if {$check_addons == 0} {
  152. blacktools:update_put $hand $chan 1 ""
  153. return
  154. }
  155. set status [blacktools:update_verify]
  156. if {$status == -1} {
  157. blacktools:update_put $hand $chan 2 ""
  158. return 0
  159. }
  160. set data [split $status "\n"]
  161. set new_version [lindex [lindex $data 0] 1]
  162. set last_modify [lindex [lindex $data 1] 2]
  163. set status [lindex [lindex $data 2] 1]
  164. if {$black(vers) != $new_version} {
  165. blacktools:update_put $hand $chan 3 [list $new_version]
  166. } elseif {$last_modify != $black(current_modif)} {
  167. blacktools:update_put $hand $chan 4 [list $black(vers)]
  168. } else {
  169. blacktools:update_put $hand $chan 5 ""
  170. return 0
  171. }
  172. if {![file isdirectory $black(backup_dir)]} {
  173. if {[catch {file mkdir $black(backup_dir)} error] != 0} {
  174. blacktools:update_put $hand $chan 6 [list $error]
  175. return 0
  176. }
  177. }
  178. if {[file exists $black(backup_dir)/BlackTools.tcl]} {
  179. blacktools:update_put "" "" 7 ""
  180. file delete -force $black(backup_dir)/BlackTools
  181. file delete -force $black(backup_dir)/BlackTools.tcl
  182. }
  183. if {[catch {file copy -force "$black(dirname)/BlackTools" $black(backup_dir)} error_b] == 0} {
  184. blacktools:update_put "" "" 8 ""
  185. } else {
  186. blacktools:update_put $hand $chan 9 [list $error_b]
  187. file delete -force $black(backup_dir)
  188. return 0
  189. }
  190. if {[catch {file copy -force $black(tclconfig) $black(backup_dir)} error_b] != 0} {
  191. blacktools:update_put $hand $chan 10 ""
  192. file delete -force $black(backup_dir)
  193. return 0
  194. } else {
  195. blacktools:update_put "" "" 11 ""
  196. }
  197. set black(update_hand) $hand
  198. set black(update_version) $new_version
  199. set black(update_last_modify) $last_modify
  200. set black(update_chan) $chan
  201. blacktools:every 1000 {
  202. if {[file isdirectory "$black(backup_dir)/BlackTools"]} {
  203. set after_file_num [llength [glob-r "$black(backup_dir)/BlackTools"]]
  204. set current_file_num [llength [glob-r "$black(actdir)/BlackTools"]]
  205. if {$current_file_num == $after_file_num} {
  206. blacktools:update_backup
  207. break
  208. }
  209. }
  210. }
  211. }
  212. ###
  213. proc blacktools:update_backup {} {
  214. global black
  215. set hand $black(update_hand)
  216. set new_version $black(update_version)
  217. set last_modify $black(update_last_modify)
  218. set chan $black(update_chan)
  219. set black(backup_update) 1
  220. set black(start_update) [unixtime]
  221. set black(update_file_saved) [llength [glob -nocomplain -directory "$black(dirname)/BlackTools/FILES" "*.txt"]]
  222. if {[file isdirectory "$black(dirname)/BlackTools/FILES/TOPWORDS"]} {
  223. set black(update_file_topwords) 1
  224. set black(update_file_saved) [expr $black(update_file_saved) + [llength [glob -nocomplain -directory "$black(dirname)/BlackTools/FILES/TOPWORDS" "*.txt"]]]
  225. }
  226. blacktools:update_put "" "" 12 ""
  227. blacktools:update_put "" "" 13 ""
  228. blacktools:update_put "" "" 14 ""
  229. blacktools:update_put $hand $chan 15 [list $new_version [ctime $last_modify]]
  230. blacktools:backup_run $hand $chan $new_version $last_modify
  231. unset black(update_version)
  232. unset black(update_last_modify)
  233. unset black(update_hand)
  234. unset black(update_chan)
  235. }
  236. ###
  237. proc blacktools:backup_run {hand chan new_version last_modify} {
  238. global black config
  239. set black(update_old_data) [blacktools:update_data 0 ""]
  240. set bt_file "$black(dirname)/BlackTools.tcl"
  241. set file [open $bt_file r]
  242. set data [read -nonewline $file]
  243. close $file
  244. set regexp_var2 "set black\\(dirname\\) \"(.*?)\""
  245. regexp -nocase $regexp_var2 $data found_line
  246. regexp -nocase $regexp_var2 $data -> found
  247. set found_line [string map [list $black(dirname) $black(backup_dir)] $found_line]
  248. regsub $regexp_var2 $data $found_line data
  249. blacktools:update_data 1 $data
  250. set file [open $config r]
  251. set data [read -nonewline $file]
  252. close $file
  253. set reg "source $black(dirname)/BlackTools.tcl"
  254. regsub $reg $data "source $black(dirname)/BlackTools.old.tcl" data
  255. set file [open $config w]
  256. puts $file $data
  257. close $file
  258. file rename -force "$black(dirname)/BlackTools.tcl" "$black(dirname)/BlackTools.old.tcl"
  259. utimer 5 [list blacktools:update_start_download $hand $chan $new_version $last_modify]
  260. }
  261. ###
  262. proc blacktools:update_start_download {hand chan new_version last_modify} {
  263. global black
  264. rehash
  265. set black(update_hand) $hand
  266. set black(update_chan) $chan
  267. file delete -force "$black(actdir)/BlackTools"
  268. ::github::github update tclscripts BlackTools-TCL $black(actdir)
  269. blacktools:every 1000 {
  270. if {[file isdirectory $black(actdir)/BlackTools]} {
  271. blacktools:update_start_restore
  272. break
  273. }
  274. }
  275. }
  276. ###
  277. #https://wiki.tcl-lang.org/page/glob
  278. proc glob-r {{dir .}} {
  279. set res {}
  280. foreach i [lsort [glob -nocomplain -dir $dir *]] {
  281. if {[file type $i] eq {directory}} {
  282. eval lappend res [glob-r $i]
  283. } else {
  284. lappend res $i
  285. }
  286. }
  287. set res
  288. } ;# RS
  289. ###
  290. proc blacktools:update_unsetflag {} {
  291. global black
  292. if {[info exists black(backup_update)]} {
  293. unset black(backup_update)
  294. }
  295. }
  296. ###
  297. proc blacktools:update_start_restore {} {
  298. global black
  299. set hand $black(update_hand)
  300. set chan $black(update_chan)
  301. set userlang [blacktools:update_userlang $hand]
  302. if {![file isdirectory "$black(actdir)/BlackTools"]} {
  303. blacktools:update_put $hand $chan 16 ""
  304. file delete -force $black(backup_dir)
  305. blacktools:update_unsetflag
  306. return
  307. } elseif {![file exists "$black(actdir)/BlackTools.tcl"]} {
  308. blacktools:update_put $hand $chan 16 ""
  309. file delete -force $black(backup_dir)
  310. blacktools:update_unsetflag
  311. return
  312. }
  313. set end_download [unixtime]
  314. set dif [expr $end_download - $black(start_update)]
  315. blacktools:update_put "" "" 17 [list [return_time $userlang $dif]]
  316. set newdata [blacktools:update_data 0 ""]
  317. blacktools:update_put $hand $chan 18 ""
  318. set restore_config [blacktools:update_restore $black(update_old_data) $newdata]
  319. unset black(update_old_data)
  320. set newdata [lindex $restore_config 0]
  321. set num_var [lindex $restore_config 1]
  322. if {$num_var > 0} {
  323. set newdata [blacktools:update_data 1 $newdata]
  324. blacktools:update_put $hand $chan 19 [list $num_var]
  325. } else {
  326. blacktools:update_put "" "" 20 ""
  327. }
  328. blacktools:update_put $hand $chan 21 ""
  329. blacktools:update_restore_files
  330. blacktools:every 1000 {
  331. set info_files_num [llength [glob -nocomplain -directory "$black(actdir)/BlackTools/FILES" "*.txt"]]
  332. if {[file isdirectory "$black(actdir)/BlackTools/FILES/TOPWORDS"]} {
  333. set info_files_topwords [llength [glob -nocomplain -directory "$black(actdir)/BlackTools/FILES/TOPWORDS" "*.txt"]]
  334. set info_files_num [expr $info_files_num + $info_files_topwords]
  335. }
  336. if {$info_files_num == $black(update_file_saved)} {
  337. blacktools:update_end $info_files_num
  338. break
  339. }
  340. }
  341. }
  342. ###
  343. proc blacktools:update_end {num} {
  344. global black config
  345. set hand $black(update_hand)
  346. set chan $black(update_chan)
  347. set userlang [blacktools:update_userlang $hand]
  348. set end_update [unixtime]
  349. set dif [expr $end_update - $black(start_update)]
  350. unset black(start_update)
  351. if {$num == 0} {
  352. blacktools:update_put "" "" 22 ""
  353. } else {
  354. blacktools:update_put $hand $chan 23 [list $num]
  355. }
  356. set file [open $config r]
  357. set data [read -nonewline $file]
  358. close $file
  359. set reg "source $black(actdir)/BlackTools.old.tcl"
  360. regsub $reg $data "source $black(actdir)/BlackTools.tcl" data
  361. set file [open $config w]
  362. puts $file $data
  363. close $file
  364. rehash
  365. unset black(update_hand)
  366. unset black(update_chan)
  367. blacktools:update_unsetflag
  368. blacktools:update_put $hand $chan 24 [list [return_time $userlang $dif]]
  369. blacktools:update_put $hand $chan 25 [list $black(backup_dir) $black(log_file)]
  370. blacktools:update_put $hand $chan 26 ""
  371. unset black(update_file_saved)
  372. file delete -force "$black(actdir)/BlackTools.old.tcl"
  373. }
  374. ###
  375. proc blacktools:update_restore_files {} {
  376. global black
  377. set files ""
  378. set counter 0
  379. set files [glob -nocomplain -directory "$black(backup_dir)/BlackTools/FILES" "*.txt"]
  380. if {![file isdirectory "$black(actdir)/BlackTools/FILES"]} {
  381. file mkdir "$black(actdir)/BlackTools/FILES"
  382. }
  383. foreach f $files {
  384. incr counter
  385. set filename [file tail $f]
  386. file copy -force $f "$black(actdir)/BlackTools/FILES/$filename"
  387. }
  388. if {[info exists black(update_file_topwords)]} {
  389. if {![file isdirectory "$black(actdir)/BlackTools/FILES/TOPWORDS"]} {
  390. file mkdir "$black(actdir)/BlackTools/FILES/TOPWORDS"
  391. }
  392. set topwords_files [glob -nocomplain -directory "$black(backup_dir)/BlackTools/FILES/TOPWORDS" "*.txt"]
  393. foreach f $topwords_files {
  394. incr counter
  395. set filename [file tail $f]
  396. file copy -force $f "$black(actdir)/BlackTools/FILES/TOPWORDS/$filename"
  397. }
  398. }
  399. unset black(update_file_topwords)
  400. return $counter
  401. }
  402. ###
  403. proc blacktools:update_set_time {num type} {
  404. global black
  405. set bt_file "$black(dirname)/BlackTools.tcl"
  406. set file [open $bt_file r]
  407. set data [read -nonewline $file]
  408. close $file
  409. set regexp_var2 "set black\\(update_time_check\\) \"(.*?)\""
  410. regexp -nocase $regexp_var2 $data -> found
  411. if {$type == 0} {
  412. return $found
  413. } else {
  414. regexp -nocase $regexp_var2 $data found_line
  415. set found_line [string map [list $found $num] $found_line]
  416. regsub $regexp_var2 $data $found_line data
  417. blacktools:update_data 1 $data
  418. }
  419. }
  420. ###
  421. proc blacktools:update_on_off {type} {
  422. global black
  423. set regexp_var2 "set black\\(update_type\\) \"(.*?)\""
  424. set bt_file "$black(dirname)/BlackTools.tcl"
  425. set file [open $bt_file r]
  426. set data [read -nonewline $file]
  427. close $file
  428. regexp -nocase $regexp_var2 $data found_line
  429. regexp -nocase $regexp_var2 $data -> found
  430. if {$type == 0 && $found == 0} {
  431. return 0
  432. }
  433. if {$type == 1 && $found == 1} {
  434. return 1
  435. }
  436. switch $type {
  437. 0 {
  438. set found_line [string map {"1" "0"} $found_line]
  439. regsub $regexp_var2 $data $found_line data
  440. blacktools:update_data 1 $data
  441. return 2
  442. }
  443. 1 {
  444. set found_line [string map {"0" "1"} $found_line]
  445. regsub $regexp_var2 $data $found_line data
  446. blacktools:update_data 1 $data
  447. return 3
  448. }
  449. }
  450. }
  451. ###
  452. proc blacktools:update_restore {data newdata} {
  453. global black
  454. set current_data $newdata
  455. set variables [regexp -all -inline {set black\((.+?)\)} $data]
  456. regsub -all {set black\((.+?)\)} $variables "" variables
  457. set var_nomodif "name author vers site current_modif"
  458. set var_counter 0
  459. foreach var $variables {
  460. if {$var == ""} {continue}
  461. if {[lsearch -nocase $var_nomodif $var] > -1} {continue}
  462. set regexp_var "set black\\($var\\) \\{(.*?)\\}"
  463. set regexp_var2 "set black\\($var\\) \"(.*?)\""
  464. regexp -nocase $regexp_var $data found_old
  465. regexp -nocase $regexp_var2 $data found_old_2
  466. if {[info exists found_old]} {
  467. set found_old [concat $found_old]
  468. regexp -nocase $regexp_var $newdata found_new
  469. if {[info exists found_new]} {
  470. if {[string equal -nocase $found_old $found_new]} {continue}
  471. incr var_counter
  472. regsub $regexp_var $current_data $found_old current_data
  473. unset found_new
  474. }
  475. unset found_old
  476. }
  477. }
  478. foreach var $variables {
  479. if {$var == ""} {continue}
  480. if {[lsearch -nocase $var_nomodif $var] > -1} {continue}
  481. set regexp_var2 "set black\\($var\\) \"(.*?)\""
  482. regexp -nocase $regexp_var2 $data found_old_2
  483. if {[info exists found_old_2]} {
  484. set found_old_2 [concat $found_old_2]
  485. regexp -nocase $regexp_var2 $newdata found_new_2
  486. if {[info exists found_new_2]} {
  487. if {[string equal -nocase $found_old_2 $found_new_2]} {continue}
  488. incr var_counter
  489. regsub $regexp_var2 $current_data $found_old_2 current_data
  490. unset found_new_2
  491. }
  492. unset found_old_2
  493. }
  494. }
  495. return [list $current_data $var_counter]
  496. }
  497. ###
  498. proc blacktools:update_data {type data} {
  499. global black
  500. set bt_file "$black(dirname)/BlackTools.tcl"
  501. if {![file exists $bt_file]} {
  502. return 0
  503. }
  504. if {$type == 0} {
  505. set file [open $bt_file r]
  506. set data [read -nonewline $file]
  507. close $file
  508. return $data
  509. } else {
  510. set file [open $bt_file w]
  511. puts $file $data
  512. close $file
  513. }
  514. }
  515. ###
  516. proc blacktools:update_verify {} {
  517. global black
  518. set link "https://raw.githubusercontent.com/tclscripts/BlackTools-TCL/master/VERSION"
  519. http::register https 443 [list ::tls::socket -autoservername true]
  520. set ipq [http::config -useragent "lynx"]
  521. set error [catch {set ipq [::http::geturl $link -timeout 10000]} eror]
  522. set status [::http::status $ipq]
  523. if {$status != "ok"} {
  524. ::http::cleanup $ipq
  525. return -1
  526. }
  527. set getipq [::http::data $ipq]
  528. ::http::cleanup $ipq
  529. return $getipq
  530. }
  531. ###
  532. proc blacktools:update_userlang {nick} {
  533. global black
  534. if {$nick == ""} {return [string tolower $black(default_lang)]}
  535. set hand [nick2hand $nick]
  536. set userlang [string tolower [getuser $hand XTRA OUTPUT_LANG]]
  537. if {$userlang == ""} { set userlang "[string tolower $black(default_lang)]" }
  538. return $userlang
  539. }
  540. ###
  541. proc blacktools:update_put {nick chan num var} {
  542. global black
  543. set counter 0
  544. foreach v $var {
  545. incr counter
  546. set replace(%msg.${counter}%) $v
  547. }
  548. if {$nick != "" && $chan != ""} {
  549. set hand [nick2hand $nick]
  550. set getmethod [getuser $hand XTRA OUTPUT_TYPE]
  551. set userlang [string tolower [getuser $hand XTRA OUTPUT_LANG]]
  552. if {$userlang == ""} { set userlang "[string tolower $black(default_lang)]" }
  553. if {$getmethod == ""} { set getmethod "0" }
  554. set text [black:color:set "" $black(say.${userlang}.autoupdate.${num})]
  555. set reply [join $text]
  556. set reply [string map [array get replace] $reply]
  557. switch $getmethod {
  558. 0 {
  559. putserv "NOTICE $nick :$reply"
  560. }
  561. 1 {
  562. putserv "PRIVMSG $chan :$reply"
  563. }
  564. 2 {
  565. putserv "PRIVMSG $nick :$reply"
  566. }
  567. }
  568. } else {
  569. set lang [string tolower $black(default_lang)]
  570. set text [black:color:set "" $black(say.${lang}.autoupdate.${num})]
  571. set reply [join $text]
  572. set reply [string map [array get replace] $reply]
  573. }
  574. putlog "\[BT\] $reply"
  575. set file [open $black(log_file) a]
  576. puts $file $reply
  577. close $file
  578. }
  579. ###
  580. #https://wiki.tcl-lang.org/page/every
  581. proc blacktools:every {interval script} {
  582. global everyIds
  583. if {$interval eq {cancel}} {
  584. after cancel $everyIds($script)
  585. return
  586. }
  587. set everyIds($script) [after $interval [namespace code [info level 0]]]
  588. set rc [catch {uplevel #0 $script} result]
  589. if {$rc == [catch break]} {
  590. after cancel $everyIds($script)
  591. set rc 0
  592. } elseif {$rc == [catch continue]} {
  593. # Ignore - just consume the return code
  594. set rc 0
  595. }
  596. # TODO: Need better handling of errorInfo etc...
  597. return -code $rc $result
  598. }