tclserv

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

0003-fireegl-cron.tcl (13116B)


      1 # cron -- A cron-like scheduler for scripts.
      2 
      3 # Copyright (C) 2010 Tcldrop Development Team <Tcldrop-Dev>
      4 
      5 # $Id$
      6 
      7 # Usage:
      8 #
      9 # cron valid $cron
     10 # 	Returns 1 if the cron format is valid, 0 otherwise.
     11 # cron parse $cron
     12 # 	Takes a standard cron time format and returns a dict containing all the possible minutes/hours/days/months/weekdays.
     13 # cron match $dict
     14 # 	Takes the dict returned from parse and returns 1 if the current time/date matches, 0 otherwise.
     15 # crontab add $cron $command ...
     16 # 	Add a new crontab, where $cron is a standard cron time format, and $command is the command to run when there's a match.  Returns an ID for the new crontab.
     17 # crontab remove $id
     18 # 	Removes a crontab by ID. 
     19 # crond start
     20 # 	Starts the 1-minute loop necessary for running the crontab commands.
     21 # 	Note: It's started automatically when a crontab is added.
     22 # crond stop
     23 # 	Stops the 1-minute loop.
     24 # 	Note: It's stopped automatically when all the crontabs are removed.
     25 
     26 # For the cron syntax, see "man 5 crontab".
     27 
     28 namespace eval ::cron {
     29 	package provide cron 1.0
     30 	variable IDCount
     31 	if {![info exists IDCount]} { variable IDCount 0 }
     32 	variable TimerID
     33 	if {![info exists TimerID]} { variable TimerID {} }
     34 	namespace export cron crontab crond
     35 	namespace ensemble create -command cron -subcommands [list match valid parse add remove start stop]
     36 	namespace ensemble create -command crontab -subcommands [list add remove]
     37 	namespace ensemble create -command crond -subcommands [list start stop]
     38 }
     39 
     40 # parses $cron and returns a dict containing all the minutes/hours/days/months/weekdays specified by $cron
     41 # Example:
     42 # input: 50-60/2 */4,21 09/2 7-9,december 7-4
     43 # result: minutes {0 50 52 54 56 58} hours {0 4 8 12 16 20 21} days {9 11 13 15 17 19 21 23 25 27 29 31} months {7 8 9 12} weekdays {0 1 2 3 4}
     44 proc ::cron::parse {cron} {
     45 	# Allow special strings:
     46 	switch -- $cron {
     47 		{@hourly} { set cron {0 * * * *} }
     48 		{@midnight} { set cron {0 0 * * *} }
     49 		{@daily} { set cron {0 1 * * *} }
     50 		{@weekly} { set cron {0 0 * * 0} }
     51 		{@monthly} { set cron {0 0 1 * *} }
     52 		{@yearly} - {@annually} { set cron {0 0 1 1 *} }
     53 		{@reboot} { return -code error {@reboot not supported.} }
     54 	}
     55 	foreach info {{minutes 0 59} {hours 0 23} {days 1 31} {months 1 12} {weekdays 0 6}} element $cron {
     56 		lassign $info name min max
     57 		dict set times $name [list]
     58 		# Calls parse_element to turn the cron-syntax into one we can more generically deal with:
     59 		foreach element [parse_element $element $name] {
     60 			lassign $element skip start end
     61 			if {$end eq {}} {
     62 				# Set the end to the highest allowable.
     63 				set end $max
     64 				# Use [scan] to remove any leading 0's (zeros):
     65 			} elseif {![scan $end {%d} end]} {
     66 				# parse_element should've complained about this, but just in case:
     67 				return -code error "\"$end\" is invalid.  (Only decimal integer values are allowed.)"
     68 			} elseif {$end < $min || $end > ($max + 1)} {
     69 				return -code error "$end is outside the allowed range for ${name}: $min-$max"
     70 			}
     71 			if {$start eq {}} {
     72 				# Set the start to the lowest allowable.
     73 				set start $min
     74 				# Use [scan] to remove any leading 0's (zeros):
     75 			} elseif {![scan $start {%d} start]} {
     76 				# parse_element should've complained about this, but just in case:
     77 				return -code error "\"$start\" is invalid.  (Only decimal integer values are allowed.)"
     78 			} elseif {$start < $min || $start > ($max + 1)} {
     79 				return -code error "$start is outside the allowed range for ${name}: $min-$max"
     80 			} elseif {$start == ($max + 1)} {
     81 				# If, for example, the start (and possibly the end) is 7 for the weekday, we'll make it/them 0:
     82 				set start $min
     83 				if {$end == ($max + 1)} { set end $min }
     84 				# Note: Specifying 0-7 will still mean every day of the week.
     85 			}
     86 			# Generate the list of possible values:
     87 			set count $start
     88 			while {$count <= $end} {
     89 				if {$count == ($max + 1)} {
     90 					# If we landed on $max + 1, we set it as $min and break the loop.
     91 					# This makes 60 become 0 for minutes, 24 becomes 0 for hours, 32 becomes 1 for days, 13 becomes 1 for months, and 7 becomes 0 for weekdays..
     92 					dict lappend times $name $min
     93 					break
     94 				}
     95 				dict lappend times $name $count
     96 				incr count $skip
     97 			}
     98 		}
     99 		# Remove duplicates:
    100 		dict set times $name [lsort -unique -integer [dict get $times $name]]
    101 	}
    102 	return $times
    103 }
    104 
    105 # Used by [parse]
    106 # Parses a single cron element, returning {{skip start end} ...}
    107 # skip = the skip/step value (defaults to 1)
    108 # start = the start of the range (may not be specified)
    109 # end = the end of the range (may not be specified)
    110 proc ::cron::parse_element {element {name {}}} {
    111 	set retval [list]
    112 	foreach element [split $element {,;:|&}] {
    113 		if {$element eq {*}} {
    114 			# Example: *
    115 			lappend retval [list 1]
    116 		} elseif {[string is digit -strict $element]} {
    117 			# Example: 9
    118 			lappend retval [list 1 $element $element]
    119 		} elseif {[regexp -- {^(\d+)\-(\d+)$} $element -> from to]} {
    120 			# Example: 3-9
    121 			lappend retval [list 1 $from $to]
    122 		} elseif {[regexp -- {^\*/(\d+)$} $element -> div] && $div >= 1} {
    123 			# Example: */2
    124 			lappend retval [list $div]
    125 		} elseif {[regexp -- {^(\d+)\-(\d+)/(\d*)$} $element -> from to div]} {
    126 			# Example: 3-9/2
    127 			lappend retval [list $div $from $to]
    128 		} elseif {[regexp -- {^(\d+)/(\d*)$} $element -> from div] && $div >= 1} {
    129 			# Example: 9/2
    130 			lappend retval [list $div $from]
    131 		} elseif {[string trim $element] ne {}} {
    132 			# Ignore ""
    133 			# Try to deal with names for days/months (ranges and skip/step are not supported in this case):
    134 			switch -- $name {
    135 				{days} {
    136 					switch -nocase -- $element {
    137 						{sun} - {sunday} { set element 0 }
    138 						{mon} - {monday} { set element 1 }
    139 						{tue} - {tuesday} { set element 2 }
    140 						{wed} - {wednesday} { set element 3 }
    141 						{thu} - {thursday} { set element 4 }
    142 						{fri} - {friday} { set element 5 }
    143 						{sat} - {saturday} { set element 6 }
    144 						{default} { return -code error "Failed to process: $element" }
    145 					}
    146 				}
    147 				{months} {
    148 					switch -nocase -- $element {
    149 						{jan} - {january} { set element 1 }
    150 						{feb} - {february} { set element 2 }
    151 						{mar} - {march} { set element 3 }
    152 						{apr} - {april} { set element 4 }
    153 						{may} { set element 5 }
    154 						{jun} - {june} { set element 6 }
    155 						{jul} - {july} { set element 7 }
    156 						{aug} - {august} { set element 8 }
    157 						{sep} - {september} { set element 9 }
    158 						{oct} - {october} { set element 10 }
    159 						{nov} - {november} { set element 11 }
    160 						{dec} - {december} { set element 12 }
    161 						{default} { return -code error "Failed to process: $element" }
    162 					}
    163 				}
    164 				{} - {default} { return -code error "Failed to process: $element" }
    165 			}
    166 			lappend retval [list 1 $element $element]
    167 		}
    168 	}
    169 	# Return the lists of skips/ranges we built up, or return {1} which means a skip of 1 and the full range.
    170 	if {[llength $retval]} { return $retval } else { list 1 }
    171 }
    172 
    173 # Takes the dict given by the output of [parse] and returns 1 if the current time/date is a match, else 0.
    174 proc ::cron::match {dict} {
    175 	lassign [clock format [clock seconds] -format {%M %k %e %N %w}] minute hour day month dayofweek
    176 	if {[scan $minute {%d}] in [dict get $dict minutes] && $hour in [dict get $dict hours] && $month in [dict get $dict months] && ($dayofweek in [dict get $dict weekdays] || $day in [dict get $dict days])} { return 1 } else { return 0 }
    177 }
    178 
    179 # Checks to see if the supplied cron is valid:
    180 proc ::cron::valid {cron} {
    181 	# This RE consists of 5 instances of the same basic RE. Each instance has
    182 	# "\d+" substituted for a RE that validates the number sequence associated
    183 	# with that instance.
    184 	#
    185 	# Base Regex, explained:
    186 	# Match any number of comma separated items if there are any:
    187 	# (0*\d+|\*)(-0*\d+)?(/\d+)?,)*
    188 	# Match the last item in this instance:
    189 	# (0*\d+|\*)(-0*\d+)?(/\d+)?\s
    190 	regexp -expanded -- {
    191 		# minute (0-59) - ([0-9]|[1-5][0-9])
    192 		^((0*([0-9]|[1-5][0-9])|\*)(-0*([0-9]|[1-5][0-9]))?(/\d+)?,)*
    193 		(0*([0-9]|[1-5][0-9])|\*)(-0*([0-9]|[1-5][0-9]))?(/\d+)?\s
    194 		# hour (0-23) - ([0-9]|1[0-9]|2[0-3])
    195 		((0*([0-9]|1[0-9]|2[0-3])|\*)(-0*([0-9]|1[0-9]|2[0-3]))?(/\d+)?,)*
    196 		(0*([0-9]|1[0-9]|2[0-3])|\*)(-0*([0-9]|1[0-9]|2[0-3]))?(/\d+)?\s
    197 		# day of month (1-31) - ([1-9]|[12][0-9]3[01])
    198 		((0*([1-9]|[12][0-9]3[01])|\*)(-0*([1-9]|[12][0-9]3[01]))?(/\d+)?,)*
    199 		(0*([1-9]|[12][0-9]3[01])|\*)(-0*([1-9]|[12][0-9]3[01]))?(/\d+)?\s
    200 		# month (1-12) - ([1-9]|1[0-2])
    201 		((0*([1-9]|1[0-2])|\*)(-0*([1-9]|1[0-2]))?(/\d+)?,)*
    202 		(0*([1-9]|1[0-2])|\*)(-0*([1-9]|1[0-2]))?(/\d+)?\s
    203 		# day of week (0-7) - [0-7]
    204 		((0*[0-7]|\*)(-0*[0-7])?(/\d+)?,)*
    205 		(0*[0-7]|\*)(-0*[0-7])?(/\d+)?$
    206 	} $cron
    207 }
    208 
    209 # Creates a new crontab which will run $args (the script) whenever the current time/date matches, 
    210 # returns an identifier which can be used to remove it.
    211 proc ::cron::add {cron args} {
    212 	if {[llength $args]} {
    213 		variable IDCount
    214 		variable crontabs
    215 		dict set crontabs [incr IDCount] [dict create cron [parse $cron] command $args]
    216 		# Start the 1-minute loop:
    217 		start
    218 		return $IDCount
    219 	}
    220 }
    221 
    222 # Removes a crontab:
    223 proc ::cron::remove {id} {
    224 	variable crontabs
    225 	if {[dict exists $crontabs $id]} {
    226 		dict unset crontabs $id
    227 		if {[dict size $crontabs] == 0} {
    228 			# Stop the 1-minute loop if there aren't any crontabs set.
    229 			stop
    230 		}
    231 	}
    232 }
    233 
    234 # This is the 1-minute looping proc, it processes all the matching crontabs for this minute:
    235 proc ::cron::DoCron {} {
    236 	# Start another after timer to run this proc again at the start of the next minute + 1 second + 17ms to 126ms:
    237 	variable TimerID [after [expr { 60000 - ([clock milliseconds] % 60000) + 1017 + int(rand() * 127) }] [namespace code DoCron]]
    238 	# Run all the crontabs that match for this minute:
    239 	variable crontabs
    240 	set count 231
    241 	dict for {id info} $crontabs {
    242 		if {[match [dict get $info cron]]} {
    243 			# Run this command 16 to 256ms from now..
    244 			# (Trying to make each command in this batch run 16ms apart.)
    245 			after [expr { 16 + ([incr count 16] % 247) }] [dict get $info command]
    246 		}
    247 	}
    248 	# Notes and logic behind the weird expr's:
    249 	# The extra 1 second added to the 1-minute loop is to avoid any issue with leap seconds...
    250 	# If an extra second is added due to leap seconds, 
    251 	# the loop would start at the 59th second of the minute it already did.
    252 	# (I think, I don't know this for sure.)
    253 	# 
    254 	# Example:
    255 	# An after timer is started at 23:59:00 to run 1000ms in the future.
    256 	# If a leap-second is added, when the script runs after 1000ms is up
    257 	# it will then be 23:59:59 when the script does a [clock format].
    258 	# (Somebody correct me if I'm wrong please.)
    259 	# I may be off by 1 minute..  If the leap second is added at 00:00:00,
    260 	# the script, when run, would see the time as 00:00:59.
    261 	#
    262 	# The extra 16ms between running the commands is so they don't run 
    263 	# all at once, causing the process to use a lot of CPU-time in a short
    264 	# amount of time.  If they're 16ms apart, it spreads the load out.
    265 	# 16ms, on Windows XP at least, is how often a process gets its share of the CPU.
    266 	#
    267 	# There's no good reason for the rand(). =P
    268 	#
    269 	# The effect of all this, is that the command scripts will run at most 1.4 seconds into the minute.
    270 }
    271 
    272 # Starts the 1-minute loop if it's not already running:
    273 proc ::cron::start {} {
    274 	variable TimerID
    275 	if {$TimerID eq {}} {
    276 		variable TimerID [after [expr { 60000 - ([clock milliseconds] % 60000) + 1017 + int(rand() * 127) }] [namespace code DoCron]]
    277 	}
    278 }
    279 
    280 # Stops the 1-minute loop:
    281 proc ::cron::stop {} {
    282 	variable TimerID
    283 	after cancel $TimerID
    284 	variable TimerID {}
    285 }
    286 
    287 # The rest is just used for testing purposes:
    288 
    289 #            field          allowed values
    290 #              -----          --------------
    291 #              minute         0-59
    292 #              hour           0-23
    293 #              day of month   1-31
    294 #              month          1-12 (or names, see below)
    295 #              day of week    0-7 (0 or 7 is Sun, or use names)
    296 
    297 if {0} {
    298 	namespace eval ::cron {
    299 		puts "now: [clock format [clock seconds] -format {%M %H %d %m %w}]"
    300 		# minute hour day month weekday
    301 		set testval "50-60/2;09 */4,21 09/2 7-9,december *"
    302 		#set testval $argv
    303 		puts "cron input: $testval"
    304 		puts "parse result: [set parseresult [::cron::parse $testval]]"
    305 		puts "match result: [::cron::match $parseresult]"
    306 		puts "parse time: [time { ::cron::parse $testval } 10000]"
    307 		puts "match time: [time { ::cron::match $parseresult } 10000]"
    308 		set matchmax [dict create minutes {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59} hours {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23} days {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31} months {1 2 3 4 5 6 7 8 9 10 11 12} weekdays {0 1 2 3 4 5 6}]
    309 		puts "match time (max): [time { ::cron::match $matchmax } 10000]"
    310 		set matchmin [dict create minutes {} hours {} days {} months {} weekdays {}]
    311 		puts "match time (min): [time { ::cron::match $matchmin } 10000]"
    312 		add {*/2} puts test
    313 	}
    314 	after 999999 [list set ::forever 1]
    315 	vwait ::forever
    316 }
    317 
    318 puts stdout "fireegl was here"
    319 namespace eval cron {
    320 	namespace export *
    321 	namespace ensemble create
    322 }