Currently this is single threaded so that a long
running task could overshadow an adjacent alarm
if it runs past its trigger time.
;; A Unix like cron scheduler for Windows.
;; by John W. Small
;; usage: newlisp cron.lsp [crontab]
;; crontab file:
;;
;; # This is a comment!
;;
;; # Fields:
;;
;; # minute: 0-59
;; # hour: 0-23
;; # day of the month: 1-31
;; # month of the year: 1-12
;; # day of the week: 0-6 with Sunday = 0
;;
;; # Field may contain a number, i.e. 5
;; # A comma separated (no spaces), i.e. 5,6,7
;; # A range (no spaces), i.e. 5-7
;; # an asterisk, i.e. * meaning all values
;;
;; # Scheduled tasks
;; # min hour monthday month weekday command arg
;;
;; 0 22 * * * start e:/backup/nightly.bat
;; 30 23 * * 5 start e:/backup/weekly.bat
(set 'crontab "crontab")
(set 'crontab-last-modified nil)
(set 'crontab-contents nil)
; find crontab
(let ((argv (main-args)))
(let ((argc (length argv)))
(if (> argc (if (= (first argv) "newlisp") 2 1))
(set 'crontab (nth (- argc 1) argv)))))
(if (not (file? crontab))
(begin
(println)
(println "crontab not found: " crontab)
(exit)))
(define (set-daylight-corrected-timezone)
(set 'daylight-corrected-timezone (- 0 (last (now))))
(let ((local-date (parse (date (apply date-value (now))) {s+} 0)))
(let ((local-time (nth 3 local-date)))
(let ((local-hour (integer (first (parse local-time ":"))))
(local-timezone-hour (nth 3 (now daylight-corrected-timezone))))
(set 'daylight-corrected-timezone
(+ daylight-corrected-timezone
(* 60 (- local-hour local-timezone-hour))))))))
; re-load crontab if changed
(define (crontab-refresh , crontab-file row-idx line fields)
(set-daylight-corrected-timezone)
(let ((last-modified (nth 6 (file-info crontab))))
(if (or (not crontab-last-modified)
(> last-modified crontab-last-modified))
(begin
(println)
(println (date (apply date-value (now))))
(println "Loading crontab: " crontab)
(set 'crontab-last-modified last-modified)
(set 'crontab-file (open crontab "read"))
(set 'crontab-contents '())
(set 'row-idx 0)
(while (read-line crontab-file)
(set 'line (trim (current-line)))
(set 'fields (filter (fn (f) (> (length f) 0))
(parse line {s+} 0)))
(if (and (> (length fields) 0)
(!= (nth 0 (first fields)) "#"))
(begin
(push fields crontab-contents row-idx)
(inc 'row-idx))))
(close crontab-file))))
crontab-contents)
(define (alarmed? scheduled actual , after before)
(or (= scheduled "*")
(cond
((find "," scheduled)
(find actual (map integer (parse scheduled ","))))
((find "-" scheduled)
(map set '(after before) (map integer (parse scheduled "-")))
(and (>= actual after) (<= actual before)))
(true
(= actual (integer scheduled))))))
;; list-let usage:
;;
;; (list-let '(1 2 3) (x y z)
;; (println x y z)
;; (list x y z))
(define-macro (list-let _values _vars)
(let ((bindings (map (fn (_var _value) (list _var _value))
_vars (eval _values)))
(body (rest (rest (args)))))
(eval (cons 'let (cons bindings body)))))
(while (crontab-refresh)
(list-let (now daylight-corrected-timezone)
(year month day hour minute sec micsec doy dow tz)
(dec 'dow)
(dolist (crontab-record crontab-contents)
(list-let crontab-record
(t_minute t_hour t_day t_month t_dow t_cmd t_arg)
(if (and
(alarmed? t_month month)
(alarmed? t_day day)
(alarmed? t_dow dow)
(alarmed? t_hour hour)
(alarmed? t_minute minute))
(if (file? t_arg)
(begin
(println)
(println (date (apply date-value (now))))
(println "Alarm on: " (join crontab-record " "))
(println t_cmd " " t_arg)
(exec t_arg)))))))
(sleep 60000))
(exit)
see first cron.lsp which has been corrected
see first cron.lsp which has been corrected
Not even using it yet and already I like it :-)
Great tool.!!! I missed thisone back in 1995 when NT 3.51 had
such a dammm irritating "AT" command ;-) But then again those
days "newlisp" wasnt on the market yet... Ill hook it on ;-)
Regards, Norman.