AboutSummaryRefsLogTreeCommitDiffStats
diff options
context:
space:
mode:
authorDale Mellor <mcron-lsfnyl@rdmp.org>2022-07-07 16:51:31 +0100
committerDale Mellor <mcron-lsfnyl@rdmp.org>2022-07-07 16:51:31 +0100
commite2ecb8045bc9789b109b1e7e0b282269a33ca9fb (patch)
tree1cc499e54f84052838260537cc94ecd46ccd0db6
parenta7a456cd6fab22eab69303a4430edf5501187299 (diff)
downloadmcron-e2ecb8045bc9789b109b1e7e0b282269a33ca9fb.tar.gz
mcron-e2ecb8045bc9789b109b1e7e0b282269a33ca9fb.tar.bz2
mcron-e2ecb8045bc9789b109b1e7e0b282269a33ca9fb.zip
Give mcron --log option to turn logging on.
This makes the behaviour backwards compatible with all previous uses of mcron. * src/mcron/base.scm: establish %do-logging parameter and act on it * src/mcron/scripts/mcron.scm: set %do-logging according to command line * tests/base.scm: some tests require %do-logging to be set
-rw-r--r--src/mcron/base.scm21
-rw-r--r--src/mcron/scripts/mcron.scm5
-rw-r--r--tests/base.scm18
3 files changed, 30 insertions, 14 deletions
diff --git a/src/mcron/base.scm b/src/mcron/base.scm
index 6e325f7..79a88a6 100644
--- a/src/mcron/base.scm
+++ b/src/mcron/base.scm
@@ -45,6 +45,7 @@
display-schedule
run-job-loop
+ %do-logging
%date-format
%log-format
validate-date-format
@@ -85,6 +86,8 @@
(user schedule-user set-schedule-user!) ;list of <job>
(current schedule-current set-schedule-current!)) ;symbol 'user or 'system
+(define %do-logging (make-parameter #f))
+
;; A (srfi srfi-19) format string for the date. It is used to format the
;; timestamp argument. Defaults to the local ISO-8601 date/time format.
(define %date-format (make-parameter "~5"))
@@ -284,7 +287,8 @@ streams can be read as well as the name of the job."
;; Execute the action.
(catch #t
(lambda ()
- (format #t "running...~%")
+ (if (%do-logging)
+ (format #t "running...~%"))
(flush-all-ports)
(let* ((result ((job:action job)))
(exit-val/maybe (false-if-exception
@@ -292,7 +296,8 @@ streams can be read as well as the name of the job."
(when (and exit-val/maybe
(not (= 0 exit-val/maybe)))
(error "unclean exit status" exit-val/maybe)))
- (format #t "completed in ~,3fs~%" (seconds-since start))
+ (if (%do-logging)
+ (format #t "completed in ~,3fs~%" (seconds-since start)))
(flush-all-ports)
(primitive-exit 0))
(lambda args
@@ -354,7 +359,11 @@ associated <job-data> instance."
(cons 'suspended partial-continuation))))
(define (format-line line)
- (format #t "~@?" (%log-format) timestamp pid name line))
+ (cond ((%do-logging)
+ (format #t "~@?" (%log-format) timestamp pid name line))
+ ((and (string? line)
+ (not (string-null? line)))
+ (display line))))
(let loop ((line+delim (read-line*)))
(match line+delim
@@ -367,8 +376,10 @@ associated <job-data> instance."
(("" . #\cr)
;; A carriage return directly followed a delimiter. Ignore it.
(loop (read-line*)))
- ((line . _)
- (format-line line)
+ ((line . delim)
+ (format-line (if (%do-logging)
+ line
+ (string-append line (string delim))))
(loop (read-line*)))))))
(for-each log-data
diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm
index 300aad0..11c0e34 100644
--- a/src/mcron/scripts/mcron.scm
+++ b/src/mcron/scripts/mcron.scm
@@ -42,6 +42,7 @@ standard input), or use all the files in ~/.config/cron (or the deprecated
-i, --stdin=(guile|vixie) Format of data passed as standard input
(default guile)
-s, --schedule[=N] Display the next N (or 8) jobs that will be run
+ -l, --log Write log messages to standard output
--log-format=FMT (ice-9 format) format string for log messages
--date-format=FMT (srfi srfi-19) date format string for log messages
-?, --help Give this help list
@@ -122,6 +123,7 @@ directory. Double-check the folder and file permissions and syntax."))))
(string=? in "vixie")))))
(schedule (single-char #\s) (value optional)
(predicate ,string->number))
+ (log (single-char #\l) (value #f))
(log-format (value #t) (predicate ,validate-log-format))
(date-format (value #t) (predicate ,validate-date-format))
(help (single-char #\?))
@@ -147,6 +149,7 @@ directory. Double-check the folder and file permissions and syntax."))))
(else (exit 0)))))
(parameterize
- ((%log-format (option-ref options 'log-format (%log-format)))
+ ((%do-logging (option-ref options 'log (%do-logging)))
+ (%log-format (option-ref options 'log-format (%log-format)))
(%date-format (option-ref options 'date-format (%date-format))))
(run-job-loop))))
diff --git a/tests/base.scm b/tests/base.scm
index 914b4c6..7d7b6d7 100644
--- a/tests/base.scm
+++ b/tests/base.scm
@@ -234,13 +234,14 @@
(sigaction SIGCHLD SIG_DFL))))))
(test-assert "run-job, output"
- (let ((output (dummy-job/capture-output
- (lambda ()
- (format #t "output line 1~%")
- (format #t "output line 2\nand 3~%")
- (system "echo poutine")
- (format (current-error-port)
- "some error~%")))))
+ (let ((output (parameterize ((%do-logging #t))
+ (dummy-job/capture-output
+ (lambda ()
+ (format #t "output line 1~%")
+ (format #t "output line 2\nand 3~%")
+ (system "echo poutine")
+ (format (current-error-port)
+ "some error~%"))))))
(assert (string-contains output "dummy: running"))
(assert (string-contains output "dummy: output line 1"))
(assert (string-contains output "dummy: and 3"))
@@ -270,7 +271,8 @@
(const #t)))
(test-assert "run-job, output with custom format"
- (let ((output (parameterize ((%log-format "the message only: ~3@*~a~%"))
+ (let ((output (parameterize ((%do-logging #t)
+ (%log-format "the message only: ~3@*~a~%"))
(dummy-job/capture-output
(lambda ()
(format #t "output line 1~%"))))))