dmbcs/mcron
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

job-specifier: Add %current-action-time parameter object.

Browse source 
* src/mcron/job-specifier.scm (current-action-time): Rename to ...
(%current-action-time): ... this.  Make it a parameter object.
(job, maybe-args): Adapt.
This commit is contained in:
Mathieu Lirzin 2016-07-18 01:25:21 +02:00
commit 109555a9dd
No known key found for this signature in database
GPG key ID: 0ADEE10094604D37
1 changed files with 21 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

47
src/mcron/job-specifier.scm
View file

@ -137,17 +137,13 @@ go into the list. For example, (range 1 6 2) returns '(1 3 5)."
(let ((time (localtime current-time))) (let ((time (localtime current-time)))
(bump-time time second-list tm:sec tm:min set-tm:sec set-tm:min))) (bump-time time second-list tm:sec tm:min set-tm:sec set-tm:min)))
(define %current-action-time
;; The time a job was last run, the time from which the next time to run a
;; The current-action-time is the time a job was last run, the time from which ;; job must be computed. (When the program is first run, this time is set to
;; the next time to run a job must be computed. (When the program is first run, ;; the configuration time so that jobs run from that moment forwards.) Once
;; this time is set to the configuration time so that jobs run from that moment ;; we have this, we supply versions of the time computation commands above
;; forwards.) Once we have this, we supply versions of the time computation ;; which implicitly assume this value.
;; commands above which implicitly assume this value. (make-parameter 0))
(define current-action-time 0)
;; We want to provide functions which take a single optional argument (as well ;; We want to provide functions which take a single optional argument (as well
;; as implicitly the current action time), but unlike usual scheme behaviour if ;; as implicitly the current action time), but unlike usual scheme behaviour if
@ -157,14 +153,14 @@ go into the list. For example, (range 1 6 2) returns '(1 3 5)."
(define (maybe-args function args) (define (maybe-args function args)
(if (null? args) (if (null? args)
(function current-action-time) (function (%current-action-time))
(function current-action-time (car args)))) (function (%current-action-time) (car args))))
;; These are the convenience functions we were striving to define for the ;; These are the convenience functions we were striving to define for the
;; configuration files. They are wrappers for the next-X-from functions above, ;; configuration files. They are wrappers for the next-X-from functions above,
;; but implicitly use the current-action-time for the time argument. ;; but implicitly use %CURRENT-ACTION-TIME for the time argument.
(define (next-year . args) (maybe-args next-year-from args)) (define (next-year . args) (maybe-args next-year-from args))
(define (next-month . args) (maybe-args next-month-from args)) (define (next-month . args) (maybe-args next-month-from args))
@ -204,7 +200,7 @@ go into the list. For example, (range 1 6 2) returns '(1 3 5)."
;; string this is parsed as a Vixie-style time specification, and if it is a ;; string this is parsed as a Vixie-style time specification, and if it is a
;; list then we arrange to eval it (but note that such lists are expected to ;; list then we arrange to eval it (but note that such lists are expected to
;; ignore the function parameter - the last run time is always read from the ;; ignore the function parameter - the last run time is always read from the
;; current-action-time global variable). A similar normalization is applied to ;; %CURRENT-ACTION-TIME parameter object). A similar normalization is applied to
;; the action. ;; the action.
;; ;;
;; Here we also compute the first time that the job is supposed to run, by ;; Here we also compute the first time that the job is supposed to run, by
@ -240,17 +236,16 @@ go into the list. For example, (range 1 6 2) returns '(1 3 5)."
(getpw user) (getpw user)
user))) user)))
(add-job (lambda (current-time) (add-job (lambda (current-time)
(set! current-action-time current-time) ;; ?? !!!! Code (parameterize ((%current-action-time current-time))
;; Allow for daylight savings time changes.
;; Contributed by Sergey Poznyakoff to allow for daylight savings (let* ((next (time-proc current-time))
;; time changes. (gmtoff (tm:gmtoff (localtime next)))
(let* ((next (time-proc current-time)) (d (+ next
(gmtoff (tm:gmtoff (localtime next))) (- gmtoff
(d (+ next (- gmtoff (tm:gmtoff (localtime current-time))))))
(tm:gmtoff (localtime current-time)))))) (if (eqv? (tm:gmtoff (localtime d)) gmtoff)
(if (eqv? (tm:gmtoff (localtime d)) gmtoff) d
d next))))
next)))
action action
displayable displayable
configuration-time configuration-time