-
-
Save GiuseppeChillemi/3f8c69bab18073fab0ef9aff1b9e31ab to your computer and use it in GitHub Desktop.
Rebol scheduler dialect
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
REBOL [ | |
Title: "Scheduler" | |
File: %scheduler.r | |
Purpose: "Dialected task scheduling library" | |
Author: ["SOFTINNOV / Nenad Rakocevic" "Pointillistic / Gregg Irwin"] | |
Copyright: ["2009 SOFTINNOV" "2013 SOFTINNOV/POINTILLISTIC"] | |
Email: [[email protected] [email protected]] | |
Date: 28-Oct-2013 | |
Version: 0.9.5 | |
License: "BSD - see %LICENCE.txt file" | |
Comments: { | |
Scheduler DSL quickstart | |
------------------------ | |
Legend: | |
- <value> means that the value is optional | |
- CAPITALIZED words are dialect keywords | |
o Event with a precise point in time : | |
<name:> AT time! DO action | |
or | |
<name:> ON date! AT time! DO action | |
o Event with a delay : | |
<name:> IN n <unit> DO action | |
o Recurring event : | |
<name:> EVERY | |
<n> <unit> ; recurring unit | |
<allowed> ; specific point(s) in time or duration(s) allowed | |
<NOT forbidden> ; specific point(s) in time or duration(s) forbidden | |
<OFFSET amount> ; date/time offset amount from unit | |
<AT moment> ; fixed time for each event (only the date changes) | |
<count TIMES> ; limit the number of event occurences | |
<USER-DATA value> ; any value you want to associate with the job | |
DO action ; action to execute | |
with | |
<name:>: set-word! value for naming a task (for future access using the API). | |
<n>: integer! value for unit multiplying. | |
<unit>: any of | |
s|sec|second|seconds | |
mn|min|minute|minutes | |
h|hr|hour|hours | |
d|day|days | |
w|wk|week|weeks | |
m|mo|month|months | |
<allowed>: any time (00:00:00), calendar day (#dd), weekday (mon|monday), | |
month (jan|january), range of time|calendar-days or block of any | |
of theses options. | |
<forbidden>: same options as <allowed>. | |
<moment>: date! or time! value. | |
<t>: integer! value. | |
action: file!|url!|block!|function!|word! value to be evaluated when | |
event is fired. | |
Syntactic sugar | |
--------------- | |
The default dialect is parsed in BLOCK! mode. That means that only REBOL values | |
are accepted, but some people may want to write calendar dates like: 1st, 2nd,... | |
instead or #1, #2,... So a preprocessor is included, allowing tasks to be passed | |
as string! values, extending the accepted syntax for the following cases : | |
1st, 2nd, 3rd,..nth : accepted | |
12s, 12mn, 12h, 12d,... : accepted | |
Scheduler API | |
------------- | |
scheduler/plan [spec] ; Add one or more tasks to the scheduler | |
scheduler/plan/new [spec] ; Same as above, but removes all previous tasks | |
scheduler/delete 'name ; Removes the named task from the scheduler | |
scheduler/wait ; Provides a global event loop | |
Examples | |
-------- | |
scheduler/plan [ | |
at 18:30 do http://domain.com/update.r | |
every 3 days not [#2 - #9 #12 sat sun] at 00:30 do %batch.r | |
smk: every friday at 13:00 do %test.r | |
cc: every 12 hours do %backup.r | |
every [sat sun] at 12:00 do %beep.r | |
every month on #01 do %check.r | |
] | |
scheduler/wait | |
(See %test-scheduler.r for more examples) | |
} | |
Gregg's-notes: { | |
Dialect production rule names now all end with = as a naming convention. | |
It's BNF-like, and helps distinguish them from other words. | |
I know 'times matches the N TIMES dialect syntax, but to have a count | |
value called 'times where time values are heavily used, seems confusing. | |
It is now called 'count. 'Count is also used in iCal. I also changed | |
the 'repeat field name to 'count, to match it. 'Count also seems clearer | |
there. | |
Added [on date! at time!] support to the dialect. | |
Added user-data field to jobs. | |
Code reorganization, to group things contextually, and comments. | |
Added events-up-to, to get a list of upcoming events. | |
Added error trap and log for actions. | |
} | |
] | |
scheduler: context [ | |
name: mult: unit: n: allow: forbid: on-day: at-time: offset: count: action: user-data: err: | |
type: | |
_start: _end: ; Where the event starts and ends in the dialected plan | |
s: e: ; start/end values for restricted ranges | |
value: ; Most recently parsed day, time, day-num, etc. | |
none | |
error-log: %scheduler-errors.log | |
last-error: none | |
last-exec-result: none ; not sure we'll want to keep this. Just experimenting. | |
; Jobs is a block of date!/spec pairs, where the date value is the | |
; next time that job/task should run, and the spec block is the spec | |
; for that task as it was parsed from the dialected plan. | |
jobs: make block! 8 | |
; The queue contains only specs (? only one spec at a time, ever?) | |
queue: make block! 1 | |
; Shortcut name (? is it worth it?) | |
wait-list: system/ports/wait-list | |
reset: does [ | |
clear jobs | |
clear queue | |
remove find wait-list time! | |
] | |
; Return the current date/time with no timezone information | |
get-now: has [n] [n: now n/zone: 00:00 n] | |
; Some tests set NOW to a specific date, which makes sense, but that | |
; breaks /precise. Hence, sys-now and precise-now | |
;get-now: has [n] [n: now/precise n/zone: 00:00 n] | |
sys-now: :now | |
precise-now: has [n] [n: sys-now/precise n/zone: 00:00 n] | |
; Execute the action for a given task | |
exec: func [task-spec /local action res] [ | |
last-error: none | |
if error? set/any 'res try [ | |
;print mold task-spec | |
action: select task-spec 'action | |
;?? Do we really need to switch on action type? Or can we just DO them | |
; (once we de-reference word actions)? | |
if word? :action [action: get :action] | |
either file? :action [ | |
call action | |
][ | |
set/any 'res do :action :task-spec | |
] | |
; switch type?/word :action [ | |
; url! [read action] ;?? READ, not DO? | |
; block! [do action] | |
; file! [do action] | |
; function! [do :action task-spec] | |
; word! [do get :action task-spec] | |
; ] | |
last-exec-result: either value? 'res [:res] [none] | |
][ | |
last-error: disarm res | |
;TBD: What should go in the error log? | |
write/append error-log reform [ | |
newline now/precise remold [task-spec/source third last-error] | |
] | |
] | |
] | |
; Call on-timer when the job timer goes off for the next job. It works closely | |
; with update-sys-timer. On-timer is called when a timer expires, takes the next | |
; task spec from the queue, runs it, and updates the job list with the next time | |
; that task should run. If the job was set to run only once, it's removed from | |
; the job list. | |
on-timer: has [task job] [ | |
task: take queue | |
job: back find/only jobs task | |
; Set the time for the task running now, which is used by next-event?. | |
task/last: get-now | |
; Run the actual action for the task. | |
exec task | |
; Remove jobs that don't need to execute again. | |
if any [ | |
; Have to confirm this. If task/at is a date, we want to bail, | |
; but if it's a time, we only want to bail if 'every hasn't been | |
; used in the spec. | |
date? task/at | |
all [task/at not task/unit] | |
all [task/count zero? task/count: task/count - 1] | |
none? job/1: next-event? task | |
][ | |
;print ["SCHEDULER" "on-timer" "Removing task from job list:" mold job/2] | |
remove/part job 2 | |
] | |
; Set up the next task timer | |
update-sys-timer | |
] | |
; Schedule a timer for the next task to execute, and put its spec in the queue. | |
update-sys-timer: does [ | |
; Jobs are pairs of next-task-time/spec values. Sort them to put | |
; the next upcoming task first. | |
sort/skip jobs 2 | |
; Update our public interface copy of jobs. | |
job-list: copy/deep jobs | |
; Take the current timer out of the system port wait-list, if we find one. | |
remove find wait-list time! | |
; Jobs have been sorted, so the next upcoming time is first, followed by | |
; its spec. Put the spec in the queue for on-timer to use and put the | |
; time we want it to trigger in the system port wait-list (offset from | |
; the current system time). | |
; It's possible that there was no next event for the first job, meaning | |
; it will be NONE. That won't work for setting a timer, but we can just | |
; remove all expired jobs at the head of the job list before trying. | |
while [all [not empty? jobs none? jobs/1]] [remove/part jobs 2] | |
if not empty? jobs [ | |
append/only queue jobs/2 | |
; If we don't use /precise, milliseconds creep up over time. An offset | |
; of 0.04. Task exec time doesn't seem to be the value though. | |
; By using /precise, our events are within a few ms of the target second. | |
; !! But if our intervals are longer (e.g. 5 minutes), using /precise can | |
; cause the even to trigger up to a full second early. | |
; The MAX is here because I was getting some errors in calling code that | |
; had WAITs in it. e.g. id: 'invalid-arg arg1: -0:00:03. My guess was that | |
; very close timing on things could cause a negative result to get into | |
; the list when other WAIT calls were used. I haven't seen one of those | |
; errors since I added MAX here. | |
;append wait-list difference jobs/1 get-now | |
append wait-list max 0:0:0 difference jobs/1 get-now | |
] | |
] | |
allowed?: func [spec [block!] time [time!]] [ | |
foreach v spec [ | |
either time? v [ | |
if v = time [return yes] | |
][ | |
; v is a block of two time values [start end]. | |
either v/1 <= v/2 [ | |
; Start is less than end. | |
if all [v/1 <= time time <= v/2] [return yes] | |
][ | |
; Midnight rollover logic (start is greater than end). | |
if any [ | |
all [time >= v/1 time <= 24:00] ; 23:59:59.999 | |
all [time <= v/2 time >= 00:00] | |
] [return yes] | |
] | |
] | |
] | |
no | |
] | |
; This returns NONE if there is no next event for the spec. | |
next-event?: func [spec [block!] /local new time mult] [ | |
; If they set a count for the event (number of times to exec), and | |
; it has reached zero, there is no next event for it. | |
if spec/count = 0 [return none] | |
; If the spec gave a relative time, make it an absolute time. | |
if spec/at = 'in [ | |
spec/at: search-event/short spec get-now | |
] | |
either any [date? spec/at none? spec/unit] [ | |
;-- AT -- | |
new: set-datetime spec/at get-now | |
][ | |
;-- EVERY -- | |
new: any [spec/last get-now] | |
; This logic for setting /offset isn't elegant, but the original | |
; logic just set the entire time value to the offset, which wasn't | |
; correct for some cases, and could cause plan failures. | |
;!! TBD: We may miss the first event if there's an offset, because | |
; we are adding the mult, which may put us past the next time. | |
; e.g., start plan at 6:05 with a 15 minute step and offset of | |
; 0:0, and it thinks we should start searching at 6:15, making | |
; the first event 6:30. | |
; search-event calls next-new before checking, which is | |
; part of this. It steps by spec/multiple. | |
; It looks like setting mult to 0 when the new time unit is | |
; less than the mult takes care of it. | |
if all [not spec/last spec/offset] [ | |
; new is set to NOW, and we have an offset to apply. | |
time: new/time | |
mult: any [spec/multiple 0] ; any [spec/multiple 1] | |
switch spec/unit [ | |
hour [ | |
;print 'HOUR | |
if time/hour <= mult [mult: 0] | |
time/hour: spec/offset/hour + mult | |
time/minute: spec/offset/minute | |
time/second: spec/offset/second | |
] | |
minute [ | |
;print 'MINUTE | |
if time/minute <= mult [mult: 0] | |
time/minute: spec/offset/minute + mult | |
time/second: spec/offset/second | |
] | |
second [ | |
;print 'SECOND | |
if time/second <= mult [mult: 0] | |
time/second: spec/offset/second + mult | |
] | |
] | |
new/time: time | |
] | |
if spec/at [ | |
; If it's our first time setting the event, and /at is not a | |
; full date, but just a time, and since /last isn't set, we | |
; know new/day=now/day, then, finally, if /at comes later in | |
; the day than the current time, we want to step the day back | |
; one because search-event will always step it forward at least | |
; one day, which means we miss the event for today, which should | |
; happen later in this day, not tomorrow. | |
if all [none? spec/last time? spec/at now/time <= spec/at] [ | |
new/day: new/day - 1 | |
] | |
new/time: spec/at | |
] | |
if spec/unit = 'month [ | |
new/day: any [ | |
spec/on | |
all [date? spec/offset spec/offset/day] | |
1 ; Default to the first of the month if they didn't spec a day. | |
] | |
] | |
new: search-event spec new | |
] | |
new | |
] | |
search-event: func [ | |
"Find the next date-time for the event, given a starting point in time." | |
spec [block!] | |
new [date!] "Where to start searching" | |
/short "Only create an absolute event time from a relative time. Do no contstraint checking." | |
/local tests step next-new sa sf u list | |
t-dbg-start t-dbg-end n-dbg-ct ;<< Used to test search timing | |
][ | |
u: spec/unit | |
step: any [spec/multiple 1] | |
next-new: either find [day month] u [ | |
[new/:u: new/:u + step] | |
][ | |
step: step * select [hour 1:0 minute 0:1 second 0:0:1] u | |
[new/time: new/time + step] | |
] | |
;-- Shortcut exit | |
if short [do next-new return new] | |
tests: clear [] | |
sa: spec/allow | |
sf: spec/forbid | |
;-- Constraints compilation -- | |
foreach [cond test] [ | |
[sa select sa 'cal-days] [find sa/cal-days new/day] | |
[sa select sa 'week-days] [find sa/week-days new/weekday] | |
[sa select sa 'months] [find sa/months new/month] | |
[sa select sa 'time] [allowed? sa/time new/time] | |
[sf select sf 'cal-days] [not find sf/cal-days new/day] | |
[sf select sf 'week-days] [not find sf/week-days new/weekday] | |
[sf select sf 'months] [not find sf/months new/month] | |
[sf select sf 'time] [not allowed? sf/time new/time] | |
][ | |
if all cond [append tests test] | |
] | |
;?? Is this the correct way to ensure that we don't trigger a timer | |
;!! event right away, which then messes up the other timer events | |
; so they don't honor the offset? This only happens if we start up | |
; at a time that is within the allowed range. That's a real problem | |
; if timers run 24 hours a day. | |
insert tests [new >= get-now] | |
;-- evaluation -- | |
;!! This will fail to find the next event if it's too far out, based | |
;!! on the unit type. e.g., more than 60 minutes away if your unit | |
;!! is 1 minute. That can easily happen if your allowed hours are over | |
;!! for the day when you schedule the plan. | |
; The STEP value comes into play, because we increment by that each | |
; time through our loop. e.g., a step of 30 minutes will let you have | |
; a gap of 30 hours to the next event, a step of 15 minutes works up | |
; to 15 hours, 5 minutes = 5 hours, etc. This might be where a NOT | |
; rule should be used, so we don't have to increase our loop counts | |
; too much. To support a 24 hour period, with a 5 minute step, we | |
; need to loop 288 times. A 1 minute step = 1440 loops max. | |
; Using 3600 for the seconds loop lets us go a day at 30 sec steps. | |
n-dbg-ct: 0 | |
t-dbg-start: precise-now | |
loop select [ | |
second 86'400 ; 3600 ; 60 86'400 = 1 day takes ~0.6 sec on my machine | |
minute 1'440 ; 288 ; 60 1'440 = 1 day | |
hour 24 | |
day 366 ; account for leap years | |
month 12 | |
] u [ | |
n-dbg-ct: n-dbg-ct + 1 | |
do next-new | |
if all tests [ | |
t-dbg-end: precise-now | |
;print ["DEBUG search-event FOUND" "count:" n-dbg-ct "time:" difference t-dbg-end t-dbg-start] | |
return new | |
] | |
] | |
t-dbg-end: precise-now | |
;print ["DEBUG search-event NOT FOUND" "count:" n-dbg-ct "time:" difference t-dbg-end t-dbg-start] | |
;?? TBD: Should this error out, or return NONE, if we want to have some kind of trace? | |
;print "Debug info:" | |
;print ["new:" new "step:" step "next-new:" mold next-new "spec:" mold spec "tests:" mold tests] | |
;make error! rejoin ["Can't find next event for rule " mold spec/source] | |
;print rejoin ["Can't find next event for rule " mold spec/source] | |
return none | |
] | |
; Set the dest date/time values in place, from the source value. | |
set-datetime: func [src [date! time!] dst [date!]] [ | |
if date? src [ | |
dst/date: src/date | |
; If no source time is set, dest/time will not be set. | |
if src/time [dst/time: src/time] | |
; Timezones are not accounted for in this library. | |
dst/zone: 00:00 | |
] | |
if time? src [dst/time: src] | |
dst | |
] | |
;-- Dialect support | |
; TBD: There is some type/name confusion throughout the module. In the | |
; parse rules, 'type is used for allow/forbid, but it's called | |
; 'name in the blockify/expand/store funcs. In the parse rules, | |
; 'type is set to units like 'week-days or 'month. | |
blockify: func [ | |
name [word!] "'allow or 'forbid" | |
type [word!] | |
/local blk | |
][ | |
if not find [allow forbid] name [ | |
make error! join "Blockify called with bad type:" type | |
] | |
if not block? get name [set name make block! 1] | |
name: get name | |
if not blk: select name type [ | |
repend name [type blk: make block! 1] | |
] | |
blk | |
] | |
expand: func [ | |
name [word!] "'allow or 'forbid" | |
type [word!] | |
start | |
end | |
/local list | |
][ | |
if not find [allow forbid] name [ | |
make error! join "Expand called with bad type:" type | |
] | |
list: blockify name type | |
start: -1 + to integer! form start | |
end: 1 + to integer! form end | |
repeat c min end - start 60 [insert list end - c] | |
] | |
; This is used when starting to parse a dialected spec. | |
reset-locals: has [list] [ | |
clear next find list: first self 'value | |
set next bind list self err: none | |
] | |
; Unused at this time | |
;reset-series: func [s [series!] len [integer!]] [head clear skip s len] | |
; Store an allow or forbid value | |
store: func [ | |
name [word!] "'allow or 'forbid" | |
type [word!] | |
value | |
/only | |
/local list | |
][ | |
if not find [allow forbid] name [ | |
make error! join "Store called with bad type:" type | |
] | |
list: blockify name type | |
if issue? value [value: to integer! form value] | |
either only [append/only list value] [append list value] | |
] | |
; Put a job, that we parsed from a plan, into the jobs list | |
store-job: has [record al src] [ | |
src: copy/part _start _end | |
if all [ | |
block? allow | |
block? forbid | |
not empty? intersect allow forbid | |
][ | |
make error! rejoin ["Bad specification for task (allow and forbid values intersect):" mold src] | |
] | |
record: reduce [ | |
'name all [name to word! name] | |
'multiple mult | |
'unit unit ; = ical FREQ | |
'allow allow | |
'forbid forbid | |
'on on-day | |
'at at-time | |
'offset offset ; = ical BY ? | |
'count count ; = ical COUNT | |
'action :action ; get-word! to allow funcs | |
'last none ; The last time the event occurred | |
'log? yes | |
'debug? no | |
'source src | |
'user-data user-data | |
] | |
;probe new-line/all copy/part record 20 off | |
repend jobs [next-event? record record] | |
] | |
;------------------------------------------------------------------------------- | |
;-- Block Dialect | |
digits=: charset "0123456789" | |
; Not used at this time | |
;cal-days=: [set n integer!] | |
week-days=: [ | |
['Monday | 'Mon] (n: 1) | |
| ['Tuesday | 'Tue] (n: 2) | |
| ['Wednesday | 'Wed] (n: 3) | |
| ['Thursday | 'Thu] (n: 4) | |
| ['Friday | 'Fri] (n: 5) | |
| ['Saturday | 'Sat] (n: 6) | |
| ['Sunday | 'Sun] (n: 7) | |
] | |
months=: [ | |
['January | 'Jan] (n: 1) | |
| ['February | 'Feb] (n: 2) | |
| ['March | 'Mar] (n: 3) | |
| ['April | 'Apr] (n: 4) | |
| ['May | 'May] (n: 5) | |
| ['June | 'Jun] (n: 6) | |
| ['July | 'Jul] (n: 7) | |
| ['August | 'Aug] (n: 8) | |
| ['September | 'Sep] (n: 9) | |
| ['October | 'Oct] (n: 10) | |
| ['November | 'Nov] (n: 11) | |
| ['December | 'Dec] (n: 12) | |
] | |
delays=: [ | |
['seconds | 'second | 'sec | 's] (unit: 'second) | |
| ['minutes | 'minute | 'min | 'mn] (unit: 'minute) | |
| ['hours | 'hour | 'hr | 'h] (unit: 'hour) | |
| ['days | 'day | 'd] (unit: 'day) | |
| ['weeks | 'week | 'wk | 'w] (unit: 'day mult: 7 * any [mult 1]) | |
| ['months | 'month | 'mo] (unit: 'month) opt on-day= | |
;| 'last-day-of-month (unit: 'ldom) ; unsupported use every -1, -2...?? | |
;| 'day-of-year (unit: 'doy) ; unsupported | |
] | |
on-day=: ['on set value issue! (unit: 'day store 'allow 'cal-days value)] | |
week-months=: [ | |
week-days= (unit: 'day store type 'week-days n) | |
| months= (unit: any [unit 'month] store type 'months n) | |
opt on-day= | |
] | |
restriction=: [ | |
opt 'from set s issue! ['- | 'to] set e issue! (expand type 'cal-days s e) | |
| opt 'from set s time! ['- | 'to] set e time! (store/only type 'time reduce [s e]) | |
| set value time! (store type 'time value) | |
| set value issue! (unit: 'day store type 'cal-days value) | |
| week-months= | |
] | |
restrictions=: [restriction= | into [some restriction=]] | |
count=: [set count integer! ['times | 'time]] | |
at-time=: [ | |
'on set at-time date! 'at set value time! (at-time/time: value) | |
| 'at set at-time [date! | time!] | |
] | |
every-rule=: [ | |
; Changed integer! to number! for mult, to allow for partial intervals | |
; e.g., sub-second timers. Need to test for regression errors. | |
opt [set mult number!] | |
[ | |
(type: 'allow) restrictions= opt on-day= | |
| [delays= | (type: 'allow) week-months=] opt [(type: 'allow) restrictions=] | |
] | |
1 4 [ | |
opt ['not (type: 'forbid) restrictions=] | |
opt ['offset set offset [date! | time!]] | |
opt at-time= | |
opt count= | |
] | |
] | |
; 'With is a nicer word if user-data comes after the action. | |
user-data=: [['user-data | 'with] set user-data any-type!] | |
action=: [ | |
'do set action [file! | url! | block! | word! | function! | paren!] | |
] | |
dialect=: [ | |
any [ | |
(reset-locals) | |
err: _start: | |
opt [set name set-word!] | |
[ | |
at-time= | |
| 'in set mult integer! delays= (at-time: 'in) | |
| 'every every-rule= | |
] | |
; User-data can come before or after the action. | |
opt user-data= | |
action= | |
opt user-data= | |
_end: | |
(store-job) | |
] | |
] | |
;-- End Block Dialect | |
;------------------------------------------------------------------------------- | |
;-- String Dialect | |
; This is for internal use. It's not a public interface. | |
pre-process: func [src [string!] /local s e v fix out] [ | |
fix: [e: (s: change/part s v e) :s] | |
parse/all src [ | |
any [ | |
s: "1st" (v: "#1") fix | |
| "2nd" (v: "#2") fix | |
| "3rd" (v: "#3") fix | |
| "21st" (v: "#21") fix | |
| "22nd" (v: "#22") fix | |
| "23rd" (v: "#23") fix | |
| "31st" (v: "#31") fix | |
| copy v 1 3 digits= [ | |
"th" (v: join "#" v) fix | |
| "s" (v: join v " s") fix | |
| "mn" (v: join v " mn") fix | |
| "h" (v: join v " h") fix | |
| "w" (v: join v " w") fix | |
| "m" (v: join v " m") fix | |
] | |
| skip | |
] | |
] | |
if none? out: attempt [load/all src] [ | |
make error! join "Scheduler input syntax error in: " src | |
] | |
out | |
] | |
;-- End String Dialect | |
;------------------------------------------------------------------------------- | |
;-- Public Interface | |
delete: func [name [word!] /local job] [ | |
job: jobs | |
forskip job 2 [ | |
if job/2/name = name [ | |
remove/part job 2 | |
return true | |
] | |
] | |
make error! reform ["job" mold name "not found!"] | |
] | |
;!! Be careful calling this if you have events with very low intervals. | |
; E.g., getting all events that happen every second for the next year | |
; has to find a lot of events. | |
events-up-to: func [ | |
"Return a block of upcoming events" | |
end [date!] "Return events that occur up to this point in time" | |
/local job-blk task next-evt res | |
][ | |
sort/skip job-blk: copy/deep job-list 2 ;!! copy/deep is important here! | |
if empty? job-blk [return copy []] | |
res: copy [] | |
while [ | |
all [ | |
not empty? job-blk | |
next-evt: job-blk/1: job-blk/2/last: next-event? job-blk/2 | |
next-evt <= end | |
next-evt >= get-now | |
] | |
][ | |
task: job-blk/2 | |
if next-evt [ | |
repend res [next-evt new-line/all copy task off] | |
] | |
; Remove jobs that don't need to execute again. | |
if any [ | |
; Have to confirm this. If task/at is a date, we want to bail, | |
; but if it's a time, we only want to bail if 'every hasn't been | |
; used in the spec. I think task/unit is the best way to check that. | |
date? task/at | |
all [task/at not task/unit] | |
all [task/count zero? task/count: task/count - 1] | |
none? next-evt | |
][ | |
;print [next-evt end task/last next-evt <= end] | |
;print "*** Removing task" | |
remove/part job-blk 2 | |
] | |
sort/skip job-blk 2 | |
] | |
new-line/skip res on 2 | |
] | |
; Encourage people to use this, rather than 'jobs, so they can't screw | |
; things up by modifying it. It will be a deep copy of 'jobs. | |
job-list: copy/deep jobs | |
;?? Would plan-events be a better name? | |
plan: func [ | |
spec [block! string!] | |
/new "Clear the current plan before setting up the new one." | |
][ | |
if new [reset] | |
if string? spec [spec: pre-process spec] | |
if not parse copy/deep spec dialect= [ | |
print ["Error parsing schedule plan at rule:" mold copy/part err 10] | |
] | |
update-sys-timer | |
] | |
;TBD: Make sure this doesn't set any vars during the parse that would mess | |
; up a running plan, or one about to be scheduled. | |
plan-ok?: func [ | |
"See if a plan can be parsed successfully" | |
spec [block! string!] | |
][ | |
if string? spec [spec: pre-process spec] | |
parse copy/deep spec dialect= | |
; Use scheduler/err to see the where the parse failed. | |
] | |
;!! Use this in place of REBOL's standard WAIT func when using a scheduler. | |
wait: does [ | |
; If (system) WAIT returns none, it means our next job timer went off. | |
while [none? system/words/wait []] [ | |
on-timer | |
if empty? jobs [exit] | |
] | |
] | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment