bug-mcron
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH] job-specifier: Add next-week configuration method.


From: Antero Mejr
Subject: [PATCH] job-specifier: Add next-week configuration method.
Date: Fri, 30 Sep 2022 16:05:15 -0400

* src/mcron/job-specifier.scm (next-week): New procedure.
* tests/job-specifier.scm (next-week): New test.
---
 src/mcron/job-specifier.scm | 24 ++++++++++++++++++++----
 tests/job-specifier.scm     |  7 +++++++
 2 files changed, 27 insertions(+), 4 deletions(-)

diff --git a/src/mcron/job-specifier.scm b/src/mcron/job-specifier.scm
index 7eb2304..af5b649 100644
--- a/src/mcron/job-specifier.scm
+++ b/src/mcron/job-specifier.scm
@@ -38,6 +38,7 @@
   #:export (range
             next-year-from         next-year
             next-month-from        next-month
+            next-week-from         next-week
             next-day-from          next-day
             next-hour-from         next-hour
             next-minute-from       next-minute
@@ -74,8 +75,9 @@ go into the list.  For example, (range 1 6 2) returns '(1 3 
5)."
              (if (> time current) (exact-min time closest+) closest+)
              rest)))))
 
-(define (bump-time time value-list component higher-component
-                   set-component! set-higher-component!)
+(define* (bump-time time value-list component higher-component
+                    set-component! set-higher-component!
+                    #:optional (increment 1))
   ;; Return the time corresponding to some near future hour.  If hour-list is
   ;; not supplied, the time returned corresponds to the start of the next hour
   ;; of the day.
@@ -88,11 +90,11 @@ go into the list.  For example, (range 1 6 2) returns '(1 3 
5)."
   ;; ... except that the function is actually generalized to deal with
   ;; seconds, minutes, etc., in an obvious way :-)
   (if (null? value-list)
-      (set-component! time (1+ (component time)))
+      (set-component! time (+ increment (component time)))
       (match (%find-best-next (component time) value-list)
         ((smallest . closest+)
          (cond ((inf? closest+)
-                (set-higher-component! time (1+ (higher-component time)))
+                (set-higher-component! time (+ increment (higher-component 
time)))
                 (set-component! time smallest))
                (else
                 (set-component! time closest+))))))
@@ -121,6 +123,16 @@ go into the list.  For example, (range 1 6 2) returns '(1 
3 5)."
     (set-tm:sec   time 0)
     (bump-time time month-list tm:mon tm:year set-tm:mon set-tm:year)))
 
+(define* (next-week-from current-time #:optional (week-list '()))
+  (let ((time (localtime current-time)))
+    (set-tm:hour  time 0)
+    (set-tm:min   time 0)
+    (set-tm:sec   time 0)
+    (bump-time time
+               ;; no tm:week, so convert week-list->day-list here
+               (map (lambda (x) (+ 1 (* 7 x))) week-list)
+               tm:mday tm:mon set-tm:mday set-tm:mon 7)))
+
 (define* (next-day-from current-time #:optional (day-list '()))
   (let ((time (localtime current-time)))
     (set-tm:hour  time 0)
@@ -163,6 +175,10 @@ go into the list.  For example, (range 1 6 2) returns '(1 
3 5)."
   "Compute the next month from %CURRENT-ACTION-TIME parameter object."
   (next-month-from (%current-action-time) args))
 
+(define* (next-week #:optional (args '()))
+  "Compute the next week from %CURRENT-ACTION-TIME parameter object."
+  (next-week-from (%current-action-time) args))
+
 (define* (next-day #:optional (args '()))
   "Compute the next day from %CURRENT-ACTION-TIME parameter object."
   (next-day-from (%current-action-time) args))
diff --git a/tests/job-specifier.scm b/tests/job-specifier.scm
index 70dd518..36e05da 100644
--- a/tests/job-specifier.scm
+++ b/tests/job-specifier.scm
@@ -67,6 +67,13 @@
   5097600
   (next-month-from 101 '(0 2 4)))
 
+(test-equal "next-week"
+  (list 1296000 1814400)
+  ;; Jan 9 (week 1) -> Jan 16 (week 2)
+  (list (next-week-from 691260)
+        ;; Jan 1 (week 0) -> Jan 22 (week 3)
+        (next-week-from 60 '(3 4))))
+
 (test-equal "next-day"
   345600
   (next-day-from 4337 '(0 5 10)))
-- 
2.37.2




reply via email to

[Prev in Thread] Current Thread [Next in Thread]