diff options
author | Mathieu Lirzin <mthl@gnu.org> | 2017-04-25 16:32:49 +0200 |
---|---|---|
committer | Mathieu Lirzin <mthl@gnu.org> | 2017-09-28 18:12:27 +0200 |
commit | d01195784352b29fe13d0676a2f50d60371d007f (patch) | |
tree | c7897c43468210847e454c550ff3ef53d8d4a61a /src/mcron/scripts/mcron.scm | |
parent | c01106387f6d0866ef6fd4801473984cc642e60b (diff) | |
download | mcron-d01195784352b29fe13d0676a2f50d60371d007f.tar.gz mcron-d01195784352b29fe13d0676a2f50d60371d007f.tar.bz2 mcron-d01195784352b29fe13d0676a2f50d60371d007f.zip |
mcron: Handle command line arguments in C with argp
'argp' is a convenient and maintainable way to parse command line arguments.
Guile doesn't offer an equivalent of this, so the command line handling has
been moved to C.
* src/mcron.c (parse_args, parse_opt): New functions.
(inner_main): Call 'parse_args'.
* src/mcron/scripts/mcron.scm (show-help, %options): Delete.
(main): Remove command line handling.
Diffstat (limited to 'src/mcron/scripts/mcron.scm')
-rw-r--r-- | src/mcron/scripts/mcron.scm | 87 |
1 files changed, 27 insertions, 60 deletions
diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm index b6c7729..588734b 100644 --- a/src/mcron/scripts/mcron.scm +++ b/src/mcron/scripts/mcron.scm @@ -25,34 +25,6 @@ #:use-module (mcron vixie-specification) #:export (main)) -(define (show-help) - (display "Usage: mcron [OPTIONS] [FILES] -Run an mcron process according to the specifications in the FILES (`-' for -standard input), or use all the files in ~/.config/cron (or the -deprecated ~/.cron) with .guile or .vixie extensions. - - -v, --version Display version - -h, --help Display this help message - -sN, --schedule[=]N Display the next N jobs that will be run by mcron - -d, --daemon Immediately detach the program from the terminal - and run as a daemon process - -i, --stdin=(guile|vixie) Format of data passed as standard input or - file arguments (default guile)") - (newline) - (show-package-information)) - -(define %options - `((schedule (single-char #\s) (value #t) - (predicate ,(λ (str) (string->number str)))) - (daemon (single-char #\d) (value #f)) - (noetc (single-char #\n) (value #f)) - (stdin (single-char #\i) (value #t) - (predicate ,(λ (val) - (or (string=? val "guile") - (string=? val "vixie"))))) - (version (single-char #\v) (value #f)) - (help (single-char #\h) (value #f)))) - (define process-user-file (let ((guile-regexp (make-regexp "\\.gui(le)?$")) (vixie-regexp (make-regexp "\\.vix(ie)?$"))) @@ -102,35 +74,30 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)." ;;; Entry point. ;;; -(define* (main #:optional (args (command-line))) - (let ((opts (parse-args args %options))) - (when config-debug - (debug-enable 'backtrace)) - (cond ((option-ref opts 'help #f) - (show-help) - (exit 0)) - ((option-ref opts 'version #f) - (show-version "mcron") - (exit 0)) - (else - (%process-files (option-ref opts '() '()) - (option-ref opts 'stdin "guile")) - (cond ((option-ref opts 'schedule #f) ;display jobs schedule - => (λ (count) - (display (get-schedule (max 1 (string->number count)))) - (exit 0))) - ((option-ref opts 'daemon #f) ;run mcron as a daemon - (case (primitive-fork) - ((0) (setsid)) - (else (exit 0))))) - ;; Forever execute the 'run-job-loop', and when it drops out (can - ;; only be because a message has come in on the socket) we process - ;; the socket request before restarting the loop again. - (catch-mcron-error - (let ((fdes-list '())) - (while #t - (run-job-loop fdes-list) - ;; we can also drop out of run-job-loop because of a SIGCHLD, - ;; so must test FDES-LIST. - (unless (null? fdes-list) - (process-update-request fdes-list))))))))) +(define* (main #:optional (opts '())) + (when config-debug + (debug-enable 'backtrace)) + + (%process-files (or (assq-ref opts 'files) '()) + (if (assq-ref opts 'vixie) "vixie" "guile")) + + (cond ((assq-ref opts 'schedule) ;display jobs schedule + => (λ (count) + (display (get-schedule (max 1 count))) + (exit 0))) + ((assq-ref opts 'daemon) ;run mcron as a daemon + (case (primitive-fork) + ((0) (setsid)) + (else (exit 0))))) + + ;; Forever execute the 'run-job-loop', and when it drops out (can + ;; only be because a message has come in on the socket) we process + ;; the socket request before restarting the loop again. + (catch-mcron-error + (let ((fdes-list '())) + (while #t + (run-job-loop fdes-list) + ;; we can also drop out of run-job-loop because of a SIGCHLD, + ;; so must test FDES-LIST. + (unless (null? fdes-list) + (process-update-request fdes-list)))))) |