AboutSummaryRefsLogTreeCommitDiffStats
path: root/scm
diff options
context:
space:
mode:
authorMathieu Lirzin <mthl@gnu.org>2016-04-20 04:31:52 +0200
committerMathieu Lirzin <mthl@gnu.org>2016-05-07 23:38:53 +0200
commit5097e30babe31a40a3fb8e281fee2a472414e5f8 (patch)
treed646ccb6dcc9de9b6a347b58fbf37ac0368ed4b1 /scm
parent5da0024b934513aa76a2cb32dc8f6cb00370262a (diff)
downloadmcron-5097e30babe31a40a3fb8e281fee2a472414e5f8.tar.gz
mcron-5097e30babe31a40a3fb8e281fee2a472414e5f8.tar.bz2
mcron-5097e30babe31a40a3fb8e281fee2a472414e5f8.zip
job-specifier: Add '%find-best-next' procedure.
* scm/mcron/job-specifier.scm (find-best-next): Rename to ... (%find-best-next): ... this. Rewrite it using a functional style. All callers changed.
Diffstat (limited to 'scm')
-rw-r--r--scm/mcron/job-specifier.scm50
-rw-r--r--scm/mcron/vixie-time.scm25
2 files changed, 33 insertions, 42 deletions
diff --git a/scm/mcron/job-specifier.scm b/scm/mcron/job-specifier.scm
index 3f73b82..1c2f9d9 100644
--- a/scm/mcron/job-specifier.scm
+++ b/scm/mcron/job-specifier.scm
@@ -24,6 +24,13 @@
;; add-job function), and the procedure for declaring environment modifications.
(define-module (mcron job-specifier)
+ #:use-module (ice-9 match)
+ #:use-module (mcron core)
+ #:use-module (mcron environment)
+ #:use-module (mcron vixie-time)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:re-export (append-environment-mods)
#:export (range
next-year-from next-year
next-month-from next-month
@@ -33,15 +40,7 @@
next-second-from next-second
set-configuration-user
set-configuration-time
- job
- find-best-next)
- #:use-module (mcron core)
- #:use-module (mcron environment)
- #:use-module (mcron vixie-time)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-26)
- #:re-export (append-environment-mods))
-
+ job))
(define* (range start end #:optional (step 1))
"Produces a list of values from START up to (but not including) END. An
@@ -49,25 +48,18 @@ optional STEP may be supplied, and (if positive) only every step'th value will
go into the list. For example, (range 1 6 2) returns '(1 3 5)."
(unfold (cut >= <> end) identity (cute + <> (max step 1)) start))
-;; Internal function (not supposed to be used directly in configuration files;
-;; it is exported from the module for the convenience of other parts of the
-;; mcron implementation) which takes a value and a list of possible next values
-;; (all assumed less than 9999). It returns a pair consisting of the smallest
-;; element of the list, and the smallest element larger than the current
-;; value. If an example of the latter cannot be found, 9999 will be returned.
-
-(define (find-best-next current next-list)
- (let ((current-best (cons 9999 9999)))
- (for-each (lambda (allowed-time)
- (if (< allowed-time (car current-best))
- (set-car! current-best allowed-time))
- (if (and (> allowed-time current)
- (< allowed-time (cdr current-best)))
- (set-cdr! current-best allowed-time)))
- next-list)
- current-best))
-
-
+(define (%find-best-next current next-list)
+ ;; Takes a value and a list of possible next values (all assumed less than
+ ;; 9999). It returns a pair consisting of the smallest element of the
+ ;; NEXT-LIST, and the smallest element larger than the CURRENT value. If an
+ ;; example of the latter cannot be found, 9999 will be returned.
+ (let loop ((smallest 9999) (closest+ 9999) (lst next-list))
+ (match lst
+ (() (cons smallest closest+))
+ ((time . rest)
+ (loop (min time smallest)
+ (if (> time current) (min time closest+) closest+)
+ rest)))))
;; Internal function to return the time corresponding to some near future
;; hour. If hour-list is not supplied, the time returned corresponds to the
@@ -89,7 +81,7 @@ go into the list. For example, (range 1 6 2) returns '(1 3 5)."
set-component! set-higher-component!)
(if (null? value-list)
(set-component! time (+ (component time) 1))
- (let ((best-next (find-best-next (component time) (car value-list))))
+ (let ((best-next (%find-best-next (component time) (car value-list))))
(if (eqv? 9999 (cdr best-next))
(begin
(set-higher-component! time (+ (higher-component time) 1))
diff --git a/scm/mcron/vixie-time.scm b/scm/mcron/vixie-time.scm
index 2f26a6d..a91fa89 100644
--- a/scm/mcron/vixie-time.scm
+++ b/scm/mcron/vixie-time.scm
@@ -15,15 +15,13 @@
;; You should have received a copy of the GNU General Public License along
;; with GNU mcron. If not, see <http://www.gnu.org/licenses/>.
-
(define-module (mcron vixie-time)
- #:export (parse-vixie-time)
- #:use-module (mcron job-specifier))
-
-
-(use-modules (srfi srfi-1) (srfi srfi-13) (srfi srfi-14)
- (ice-9 regex))
-
+ #:use-module (ice-9 regex)
+ #:use-module (mcron job-specifier)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-13)
+ #:use-module (srfi srfi-14)
+ #:export (parse-vixie-time))
;; In Vixie-style time specifications three-letter symbols are allowed to stand
;; for the numbers corresponding to months and days of the week. We deal with
@@ -179,11 +177,12 @@
;; simply unreadable without all of these aliases.
(define (increment-time-component time time-spec)
- (let* ((time-list (time-spec:list time-spec))
- (getter (time-spec:getter time-spec))
- (setter (time-spec:setter time-spec))
- (next-best (find-best-next (getter time) time-list))
- (wrap-around (eqv? (cdr next-best) 9999)))
+ (let* ((time-list (time-spec:list time-spec))
+ (getter (time-spec:getter time-spec))
+ (setter (time-spec:setter time-spec))
+ (find-best-next (@@ (mcron job-specifier) %find-best-next))
+ (next-best (find-best-next (getter time) time-list))
+ (wrap-around (eqv? (cdr next-best) 9999)))
(setter time ((if wrap-around car cdr) next-best))
wrap-around))