base: Add 'display-schedule' procedure

This procedure is a more generic and less coupled version of
'get-schedule' which has been kept for backward compatibility and
deprecated.

* src/mcron/base.scm (display-schedule): New procedure.
(get-schedule): Move to ...
* src/mcron/core.scm: ... here.
* src/mcron/scripts/cron.scm (main): Use 'display-schedule'.
* src/mcron/scripts/mcron.scm (main): Likewise.
* doc/mcron.texi (The base module): Document it.
This commit is contained in:
Mathieu Lirzin 2017-10-19 23:22:14 +02:00
commit 5f83aef90f
No known key found for this signature in database
GPG key ID: 0ADEE10094604D37
5 changed files with 32 additions and 32 deletions

View file

@ -1233,9 +1233,12 @@ entry. All jobs on the current job list that are scheduled to be run
under this personality are removed from the job list.
@end deffn
@deffn{Scheme procedure} get-schedule count
@deffn{Scheme procedure} display-schedule @var{count} [@var{port}]
@cindex schedule of jobs
The argument @var{count} should be an integer value giving the number
This procedure is used to display a textual list of the next COUNT jobs
to run.
The argument @var{count} must be an integer value giving the number
of time-points in the future to report that jobs will run as. Note
that this procedure is disruptive; if @code{run-job-loop} is called
after this procedure, the first job to run will be the one after the

View file

@ -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.

View file

@ -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))))

View file

@ -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)

View file

@ -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)