AboutSummaryRefsLogTreeCommitDiffStats
path: root/src/mcron
diff options
context:
space:
mode:
Diffstat (limited to 'src/mcron')
-rw-r--r--src/mcron/base.scm46
-rw-r--r--src/mcron/core.scm7
-rw-r--r--src/mcron/scripts/cron.scm2
-rw-r--r--src/mcron/scripts/mcron.scm2
4 files changed, 27 insertions, 30 deletions
diff --git a/src/mcron/base.scm b/src/mcron/base.scm
index 942ebf2..3528236 100644
--- a/src/mcron/base.scm
+++ b/src/mcron/base.scm
@@ -26,7 +26,7 @@
#:use-module (srfi srfi-9)
#:export (add-job
remove-user-jobs
- get-schedule
+ display-schedule
run-job-loop
;; Deprecated and undocumented procedures.
use-system-job-list
@@ -136,35 +136,27 @@ recurse the list."
(else
(loop rest next-time next-jobs))))))))
-;; Create a string containing a textual list of the next count jobs to run.
-;;
-;; Enter a loop of displaying the next set of jobs to run, artificially
-;; forwarding the time to the next time point (instead of waiting for it to
-;; occur as we would do in a normal run of mcron), and recurse around the loop
-;; count times.
-;;
-;; Note that this has the effect of mutating the job timings. Thus the program
-;; must exit after calling this function; the internal data state will be left
-;; unusable.
-
-(define (get-schedule count)
- (with-output-to-string
- (lambda ()
- (do ((count count (- count 1)))
- ((eqv? count 0))
- (and-let*
- ((next-jobs (find-next-jobs))
- (time (car next-jobs))
- (date-string (strftime "%c %z\n" (localtime time))))
+(define* (display-schedule count #:optional (port (current-output-port)))
+ "Display on PORT a textual list of the next COUNT jobs to run. This
+simulates the run of the job loop to display the resquested information.
+Since calling this procedure has the effect of mutating the job timings, the
+program must exit after. Otherwise the internal data state will be left
+unusable."
+ (unless (<= count 0)
+ (match (find-next-jobs)
+ ((#f . jobs)
+ #f)
+ ((time . jobs)
+ (let ((date-string (strftime "%c %z\n" (localtime time))))
(for-each (lambda (job)
- (display date-string)
- (display (job:displayable job))
- (newline)(newline)
+ (display date-string port)
+ (display (job:displayable job) port)
+ (newline port)
+ (newline port)
(job:next-time-set! job ((job:next-time-function job)
(job:next-time job))))
- (cdr next-jobs)))))))
-
-
+ jobs))))
+ (display-schedule (- count 1) port)))
;; For proper housekeeping, it is necessary to keep a record of the number of
;; child processes we fork off to run the jobs.
diff --git a/src/mcron/core.scm b/src/mcron/core.scm
index fcf96af..987881d 100644
--- a/src/mcron/core.scm
+++ b/src/mcron/core.scm
@@ -20,9 +20,10 @@
(define-module (mcron core)
#:use-module (mcron base)
+ #:export (;; Deprecated
+ get-schedule)
#:re-export (add-job
remove-user-jobs
- get-schedule
run-job-loop
clear-environment-mods
append-environment-mods
@@ -30,3 +31,7 @@
use-system-job-list
use-user-job-list
clear-system-jobs))
+
+(define (get-schedule count)
+ (with-output-to-string
+ (lambda () (display-schedule count))))
diff --git a/src/mcron/scripts/cron.scm b/src/mcron/scripts/cron.scm
index d043d79..5052c32 100644
--- a/src/mcron/scripts/cron.scm
+++ b/src/mcron/scripts/cron.scm
@@ -157,7 +157,7 @@ option.\n")
(option-ref opts 'noetc #f))
(cond ((option-ref opts 'schedule #f) ;display jobs schedule
=> (λ (count)
- (display (get-schedule (max 1 (string->number count))))
+ (display-schedule (max 1 (string->number count)))
(exit 0)))
(else (case (primitive-fork) ;run the daemon
((0)
diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm
index 588734b..afb380f 100644
--- a/src/mcron/scripts/mcron.scm
+++ b/src/mcron/scripts/mcron.scm
@@ -83,7 +83,7 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
(cond ((assq-ref opts 'schedule) ;display jobs schedule
=> (λ (count)
- (display (get-schedule (max 1 count)))
+ (display-schedule (max 1 count))
(exit 0)))
((assq-ref opts 'daemon) ;run mcron as a daemon
(case (primitive-fork)