1### 2# This file implements a process table 3# Instead of having individual components try to maintain their own timers 4# we centrally manage how often tasks should be kicked off here. 5### 6# 7# Author: Sean Woods (for T&E Solutions) 8package require Tcl 8.6 ;# See coroutine 9package require coroutine 10package require dicttool 11::namespace eval ::cron {} 12 13proc ::cron::task {command args} { 14 if {$::cron::trace > 1} { 15 puts [list ::cron::task $command $args] 16 } 17 variable processTable 18 switch $command { 19 TEMPLATE { 20 return [list object {} lastevent 0 lastrun 0 err 0 result {} \ 21 running 0 coroutine {} scheduled 0 frequency 0 command {}] 22 } 23 delete { 24 unset -nocomplain ::cron::processTable([lindex $args 0]) 25 } 26 exists { 27 return [::info exists ::cron::processTable([lindex $args 0])] 28 } 29 info { 30 set process [lindex $args 0] 31 if {![::info exists ::cron::processTable($process)]} { 32 error "Process $process does not exist" 33 } 34 return $::cron::processTable($process) 35 } 36 frequency { 37 set process [lindex $args 0] 38 set time [lindex $args 1] 39 if {![info exists ::cron::processTable($process)]} return 40 dict with ::cron::processTable($process) { 41 set now [clock_step [current_time]] 42 set frequency [expr {0+$time}] 43 if {$scheduled>($now+$time)} { 44 dict set ::cron::processTable($process) scheduled [expr {$now+$time}] 45 } 46 } 47 } 48 sleep { 49 set process [lindex $args 0] 50 set time [lindex $args 1] 51 if {![info exists ::cron::processTable($process)]} return 52 dict with ::cron::processTable($process) { 53 set now [clock_step [current_time]] 54 set frequency 0 55 set scheduled [expr {$now+$time}] 56 } 57 } 58 create - 59 set { 60 set process [lindex $args 0] 61 if {![::info exists ::cron::processTable($process)]} { 62 set ::cron::processTable($process) [task TEMPLATE] 63 } 64 if {[llength $args]==2} { 65 foreach {field value} [lindex $args 1] { 66 dict set ::cron::processTable($process) $field $value 67 } 68 } else { 69 foreach {field value} [lrange $args 1 end] { 70 dict set ::cron::processTable($process) $field $value 71 } 72 } 73 } 74 } 75} 76 77proc ::cron::at args { 78 if {$::cron::trace > 1} { 79 puts [list ::cron::at $args] 80 } 81 switch [llength $args] { 82 2 { 83 variable processuid 84 set process event#[incr processuid] 85 lassign $args timecode command 86 } 87 3 { 88 lassign $args process timecode command 89 } 90 default { 91 error "Usage: ?process? timecode command" 92 } 93 } 94 variable processTable 95 if {[string is integer -strict $timecode]} { 96 set scheduled [expr {$timecode*1000}] 97 } else { 98 set scheduled [expr {[clock scan $timecode]*1000}] 99 } 100 ::cron::task set $process \ 101 frequency -1 \ 102 command $command \ 103 scheduled $scheduled \ 104 coroutine {} 105 106 if {$::cron::trace > 1} { 107 puts [list ::cron::task info $process - > [::cron::task info $process]] 108 } 109 ::cron::wake NEW 110 return $process 111} 112 113proc ::cron::idle args { 114 if {$::cron::trace > 1} { 115 puts [list ::cron::idle $args] 116 } 117 switch [llength $args] { 118 2 { 119 variable processuid 120 set process event#[incr processuid] 121 lassign $args command 122 } 123 3 { 124 lassign $args process command 125 } 126 default { 127 error "Usage: ?process? timecode command" 128 } 129 } 130 ::cron::task set $process \ 131 scheduled 0 \ 132 frequency 0 \ 133 command $command 134 ::cron::wake NEW 135 return $process 136} 137 138proc ::cron::in args { 139 if {$::cron::trace > 1} { 140 puts [list ::cron::in $args] 141 } 142 switch [llength $args] { 143 2 { 144 variable processuid 145 set process event#[incr processuid] 146 lassign $args timecode command 147 } 148 3 { 149 lassign $args process timecode command 150 } 151 default { 152 error "Usage: ?process? timecode command" 153 } 154 } 155 set now [clock_step [current_time]] 156 set scheduled [expr {$timecode*1000+$now}] 157 ::cron::task set $process \ 158 frequency -1 \ 159 command $command \ 160 scheduled $scheduled 161 ::cron::wake NEW 162 return $process 163} 164 165proc ::cron::cancel {process} { 166 if {$::cron::trace > 1} { 167 puts [list ::cron::cancel $process] 168 } 169 ::cron::task delete $process 170} 171 172### 173# topic: 0776dccd7e84530fa6412e507c02487c 174### 175proc ::cron::every {process frequency command} { 176 if {$::cron::trace > 1} { 177 puts [list ::cron::every $process $frequency $command] 178 } 179 variable processTable 180 set mnow [clock_step [current_time]] 181 set frequency [expr {$frequency*1000}] 182 ::cron::task set $process \ 183 frequency $frequency \ 184 command $command \ 185 scheduled [expr {$mnow + $frequency}] 186 ::cron::wake NEW 187} 188 189 190proc ::cron::object_coroutine {objname coroutine {info {}}} { 191 if {$::cron::trace > 1} { 192 puts [list ::cron::object_coroutine $objname $coroutine $info] 193 } 194 task set $coroutine \ 195 {*}$info \ 196 object $objname \ 197 coroutine $coroutine 198 199 return $coroutine 200} 201 202# Notification that an object has been destroyed, and that 203# it should give up any toys associated with events 204proc ::cron::object_destroy {objname} { 205 if {$::cron::trace > 1} { 206 puts [list ::cron::object_destroy $objname] 207 } 208 variable processTable 209 set dat [array get processTable] 210 foreach {process info} $dat { 211 if {[dict exists $info object] && [dict get $info object] eq $objname} { 212 unset -nocomplain processTable($process) 213 } 214 } 215} 216 217### 218# topic: 97015814408714af539f35856f85bce6 219### 220proc ::cron::run process { 221 variable processTable 222 dict set processTable($process) lastrun 0 223 ::cron::wake PROCESS 224} 225 226proc ::cron::clock_step timecode { 227 return [expr {$timecode-($timecode%1000)}] 228} 229 230proc ::cron::clock_delay {delay} { 231 set now [current_time] 232 set then [clock_step [expr {$delay+$now}]] 233 return [expr {$then-$now}] 234} 235 236# Sleep for X seconds, wake up at the top 237proc ::cron::clock_sleep {{sec 1} {offset 0}} { 238 set now [current_time] 239 set delay [expr {[clock_delay [expr {$sec*1000}]]+$offset}] 240 sleep $delay 241} 242 243proc ::cron::current_time {} { 244 if {$::cron::time < 0} { 245 return [clock milliseconds] 246 } 247 return $::cron::time 248} 249 250proc ::cron::clock_set newtime { 251 variable time 252 for {} {$time < $newtime} {incr time 100} { 253 uplevel #0 {::cron::do_one_event CLOCK_ADVANCE} 254 } 255 set time $newtime 256 uplevel #0 {::cron::do_one_event CLOCK_ADVANCE} 257} 258 259proc ::cron::once_in_a_while body { 260 set script {set _eventid_ $::cron::current_event} 261 append script $body 262 # Add a safety to allow this while to only execute once per call 263 append script {if {$_eventid_==$::cron::current_event} yield} 264 uplevel 1 [list while 1 $body] 265} 266 267proc ::cron::sleep ms { 268 if {$::cron::trace > 1} { 269 puts [list ::cron::sleep $ms [info coroutine]] 270 } 271 272 set coro [info coroutine] 273 # When the clock is being externally 274 # controlled, advance the clock when 275 # a sleep is called 276 variable time 277 if {$time >= 0 && $coro eq {}} { 278 ::cron::clock_set [expr {$time+$ms}] 279 return 280 } 281 if {$coro ne {}} { 282 set mnow [current_time] 283 set start $mnow 284 set end [expr {$start+$ms}] 285 set eventid $coro 286 if {$::cron::trace} { 287 puts "::cron::sleep $ms $coro" 288 } 289 # Mark as running 290 task set $eventid scheduled $end coroutine $coro running 1 291 ::cron::wake WAKE_IN_CORO 292 yield 2 293 while {$end >= $mnow} { 294 if {$::cron::trace} { 295 puts "::cron::sleep $ms $coro (loop)" 296 } 297 set mnow [current_time] 298 yield 2 299 } 300 # Mark as not running to resume idle computation 301 task set $eventid running 0 302 if {$::cron::trace} { 303 puts "/::cron::sleep $ms $coro" 304 } 305 } else { 306 set eventid [incr ::cron::eventcount] 307 set var ::cron::event_#$eventid 308 set $var 0 309 if {$::cron::trace} { 310 puts "::cron::sleep $ms $eventid waiting for $var" 311 ::after $ms "set $var 1 ; puts \"::cron::sleep - $eventid - FIRED\"" 312 } else { 313 ::after $ms "set $var 1" 314 } 315 ::vwait $var 316 if {$::cron::trace} { 317 puts "/::cron::sleep $ms $eventid" 318 } 319 unset $var 320 } 321} 322 323### 324# topic: 21de7bb8db019f3a2fd5a6ae9b38fd55 325# description: 326# Called once per second, and timed to ensure 327# we run in roughly realtime 328### 329proc ::cron::runTasksCoro {} { 330 ### 331 # Do this forever 332 ### 333 variable processTable 334 variable processing 335 variable all_coroutines 336 variable coroutine_object 337 variable coroutine_busy 338 variable nextevent 339 variable current_event 340 341 while 1 { 342 incr current_event 343 set lastevent 0 344 set now [current_time] 345 # Wake me up in 5 minute intervals, just out of principle 346 set nextevent [expr {$now-($now % 300000) + 300000}] 347 set next_idle_event [expr {$now+250}] 348 if {$::cron::trace > 1} { 349 puts [list CRON TASK RUNNER nextevent $nextevent] 350 } 351 ### 352 # Determine what tasks to run this timestep 353 ### 354 set tasks {} 355 set cancellist {} 356 set nexttask {} 357 358 foreach {process} [lsort -dictionary [array names processTable]] { 359 dict with processTable($process) { 360 if {$::cron::trace > 1} { 361 puts [list CRON TASK RUNNER process $process frequency: $frequency scheduled: $scheduled] 362 } 363 if {$scheduled==0 && $frequency==0} { 364 set lastrun $now 365 set lastevent $now 366 lappend tasks $process 367 } else { 368 if { $scheduled <= $now } { 369 lappend tasks $process 370 if { $frequency < 0 } { 371 lappend cancellist $process 372 } elseif {$frequency==0} { 373 set scheduled 0 374 if {$::cron::trace > 1} { 375 puts [list CRON TASK RUNNER process $process demoted to idle] 376 } 377 } else { 378 set scheduled [clock_step [expr {$frequency+$lastrun}]] 379 if { $scheduled <= $now } { 380 set scheduled [clock_step [expr {$frequency+$now}]] 381 } 382 if {$::cron::trace > 1} { 383 puts [list CRON TASK RUNNER process $process rescheduled to $scheduled] 384 } 385 } 386 set lastrun $now 387 } 388 set lastevent $now 389 } 390 } 391 } 392 foreach task $tasks { 393 dict set processTable($task) lastrun $now 394 if {[dict exists processTable($task) foreground] && [dict set processTable($task) foreground]} continue 395 if {[dict exists processTable($task) running] && [dict set processTable($task) running]} continue 396 if {$::cron::trace > 2} { 397 puts [list RUNNING $task [task info $task]] 398 } 399 set coro [dict getnull $processTable($task) coroutine] 400 dict set processTable($task) running 1 401 set command [dict getnull $processTable($task) command] 402 if {$command eq {} && $coro eq {}} { 403 # Task has nothing to do. Slot it for destruction 404 lappend cancellist $task 405 } elseif {$coro ne {}} { 406 if {[info command $coro] eq {}} { 407 set object [dict get $processTable($task) object] 408 # Trigger coroutine again if a command was given 409 # If this coroutine is associated with an object, ensure 410 # the object still exists before invoking its method 411 if {$command eq {} || ($object ne {} && [info command $object] eq {})} { 412 lappend cancellist $task 413 dict set processTable($task) running 0 414 continue 415 } 416 if {$::cron::trace} { 417 puts [list RESTARTING $task - coroutine $coro - with $command] 418 } 419 ::coroutine $coro {*}$command 420 } 421 try $coro on return {} { 422 # Terminate the coroutine 423 lappend cancellist $task 424 } on break {} { 425 # Terminate the coroutine 426 lappend cancellist $task 427 } on error {errtxt errdat} { 428 # Coroutine encountered an error 429 lappend cancellist $task 430 puts "ERROR $coro" 431 set errorinfo [dict get $errdat -errorinfo] 432 if {[info exists coroutine_object($coro)] && $coroutine_object($coro) ne {}} { 433 catch { 434 puts "OBJECT: $coroutine_object($coro)" 435 puts "CLASS: [info object class $coroutine_object($coro)]" 436 } 437 } 438 puts "$errtxt" 439 puts *** 440 puts $errorinfo 441 } on continue {result opts} { 442 # Ignore continue 443 if { $result eq "done" } { 444 lappend cancellist $task 445 } 446 } on ok {result opts} { 447 if { $result eq "done" } { 448 lappend cancellist $task 449 } 450 } 451 } else { 452 dict with processTable($task) { 453 set err [catch {uplevel #0 $command} result errdat] 454 if $err { 455 puts "CRON TASK FAILURE:" 456 puts "PROCESS: $task" 457 puts $result 458 puts *** 459 puts [dict get $errdat -errorinfo] 460 } 461 } 462 yield 0 463 } 464 dict set processTable($task) running 0 465 } 466 foreach {task} $cancellist { 467 unset -nocomplain processTable($task) 468 } 469 foreach {process} [lsort -dictionary [array names processTable]] { 470 set scheduled 0 471 set frequency 0 472 dict with processTable($process) { 473 if {$scheduled==0 && $frequency==0} { 474 if {$next_idle_event < $nextevent} { 475 set nexttask $task 476 set nextevent $next_idle_event 477 } 478 } elseif {$scheduled < $nextevent} { 479 set nexttask $process 480 set nextevent $scheduled 481 } 482 set lastevent $now 483 } 484 } 485 foreach {eventid msec} [array get ::cron::coro_sleep] { 486 if {$msec < 0} continue 487 if {$msec<$nextevent} { 488 set nexttask "CORO $eventid" 489 set nextevent $scheduled 490 } 491 } 492 set delay [expr {$nextevent-$now}] 493 if {$delay <= 0} { 494 yield 0 495 } else { 496 if {$::cron::trace > 1} { 497 puts "NEXT EVENT $delay - NEXT TASK $nexttask" 498 } 499 yield $delay 500 } 501 } 502} 503 504proc ::cron::wake {{who ???}} { 505 ## 506 # Only triggered by cron jobs kicking off other cron jobs within 507 # the script body 508 ## 509 if {$::cron::trace} { 510 puts "::cron::wake $who" 511 } 512 if {$::cron::busy} { 513 return 514 } 515 after cancel $::cron::next_event 516 set ::cron::next_event [after idle [list ::cron::do_one_event $who]] 517} 518 519proc ::cron::do_one_event {{who ???}} { 520 if {$::cron::trace} { 521 puts "::cron::do_one_event $who" 522 } 523 after cancel $::cron::next_event 524 set now [current_time] 525 set ::cron::busy 1 526 while {$::cron::busy} { 527 if {[info command ::cron::COROUTINE] eq {}} { 528 ::coroutine ::cron::COROUTINE ::cron::runTasksCoro 529 } 530 set cron_delay [::cron::COROUTINE] 531 if {$cron_delay==0} { 532 if {[incr loops]>10} { 533 if {$::cron::trace} { 534 puts "Breaking out of 10 recursive loops" 535 } 536 set ::cron::wake_time 1000 537 break 538 } 539 set ::cron::wake_time 0 540 incr ::cron::loops(active) 541 } else { 542 set ::cron::busy 0 543 incr ::cron::loops(idle) 544 } 545 } 546 ### 547 # Try to get the event to fire off on the border of the 548 # nearest second 549 ### 550 if {$cron_delay < 10} { 551 set cron_delay 250 552 } 553 set ctime [current_time] 554 set next [expr {$ctime+$cron_delay}] 555 set ::cron::wake_time [expr {$next/1000}] 556 if {$::cron::trace} { 557 puts [list EVENT LOOP WILL WAKE IN $cron_delay ms next: [clock format $::cron::wake_time -format "%H:%M:%S"] active: $::cron::loops(active) idle: $::cron::loops(idle) woken_by: $who] 558 } 559 set ::cron::next_event [after $cron_delay {::cron::do_one_event TIMER}] 560} 561 562 563proc ::cron::main {} { 564 # Never launch from a coroutine 565 if {[info coroutine] ne {}} { 566 return 567 } 568 set ::cron::forever 1 569 while {$::cron::forever} { 570 ::after 120000 {set ::cron::forever 1} 571 # Call an update just to give the rest of the event loop a chance 572 incr ::cron::loops(main) 573 ::after cancel $::cron::next_event 574 set ::cron::next_event [::after idle {::cron::wake MAIN}] 575 set ::cron::forever 1 576 set ::cron::busy 0 577 ::vwait ::cron::forever 578 if {$::cron::trace} { 579 puts "MAIN LOOP CYCLE $::cron::loops(main)" 580 } 581 } 582} 583 584### 585# topic: 4a891d0caabc6e25fbec9514ea8104dd 586# description: 587# This file implements a process table 588# Instead of having individual components try to maintain their own timers 589# we centrally manage how often tasks should be kicked off here. 590### 591namespace eval ::cron { 592 variable lastcall 0 593 variable processTable 594 variable busy 0 595 variable next_event {} 596 variable trace 0 597 variable current_event 598 variable time -1 599 if {![info exists current_event]} { 600 set current_event 0 601 } 602 if {![info exists ::cron::loops]} { 603 array set ::cron::loops { 604 active 0 605 main 0 606 idle 0 607 wake 0 608 } 609 } 610} 611 612::cron::wake STARTUP 613package provide cron 2.1 614 615