guile/job.scm

   1 ;; Copyright (C) 2018 Thomas Balzer
   2
   3 ;; This file is part of tomd.
   4
   5 ;; tomd is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, either version 3 of the License, or
   8 ;; (at your option) any later version.
   9
  10 ;; tomd is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU General Public License for more details.
  14
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with tomd.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 (define-module (tomd job)
  19   #:use-module (srfi srfi-9)
  20   #:export (create-job make-job
  21                        job-command-line
  22                        job-args
  23                        job-start-trigger
  24                        job-end-trigger))
  25
  26 ;;; records
  27 (define-record-type <job>
  28   (make-job command-line args start-trigger end-trigger)
  29   job?
  30   (command-line job-command-line)
  31   (args job-args)
  32   (start-trigger job-start-trigger)
  33   (end-trigger job-end-trigger))
  34
  35 ;;; functions
  36 (define (get-keyword-value args keyword default)
  37   (let ((keyword-value (memq keyword args)))
  38     (if (and keyword-value (>= (length keyword-value) 2))
  39         (cadr keyword-value)
  40         default)))
  41
  42 (define (create-job . rest)
  43   (let ((command-line  (get-keyword-value rest #:command-line  #f))
  44         (args          (get-keyword-value rest #:args          (list)))
  45         (start-trigger (get-keyword-value rest #:start-trigger 'login))
  46         (end-trigger   (get-keyword-value rest #:end-trigger   #f)))
  47     ;; do thing with keyword-ed variables
  48     (display "settings:") (newline)
  49     (format (current-output-port)
  50             "command-line:~a" command-line)
  51     (newline)
  52     (format (current-output-port)
  53             "args:~a" args)
  54     (newline)
  55     (format (current-output-port)
  56             "start-trigger:~a" start-trigger)
  57     (newline)
  58     (format (current-output-port)
  59             "end-trigger:~a" end-trigger)
  60     (newline)
  61
  62     ;; create a new object that represents the args given.
  63     (make-job command-line
  64               args
  65               start-trigger
  66               end-trigger)
  67     ))