guile/tomd/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 c-job-cmd
  22             job-args c-job-args
  23             job-start-trigger c-job-start-trigger
  24             job-end-trigger c-job-end-trigger
  25             job-name c-job-name
  26             job-redirect c-job-redirect
  27             c-check-job))
  28
  29 ;;; records
  30 (define-record-type <job>
  31   (make-job name command-line args start-trigger end-trigger redirect)
  32   job?
  33   (name job-name)
  34   (command-line job-command-line)
  35   (args job-args)
  36   (start-trigger job-start-trigger)
  37   (end-trigger job-end-trigger)
  38   (redirect job-redirect))
  39
  40 ;;; this sillyness is because i'm not sure how to expand macros in scm_call
  41 (define (c-check-job obj)
  42   (job? obj))
  43
  44 (define (c-job-cmd obj)
  45   (job-command-line obj))
  46
  47 (define (c-job-args obj)
  48   (job-args obj))
  49
  50 (define (c-job-start-trigger obj)
  51   (job-start-trigger obj))
  52
  53 (define (c-job-end-trigger obj)
  54   (job-end-trigger obj))
  55
  56 (define (c-job-name obj)
  57   (job-name obj))
  58
  59 (define (c-job-redirect obj)
  60   (job-redirect obj))
  61
  62 ;;; functions
  63 (define (get-keyword-value args keyword default)
  64   (let ((keyword-value (memq keyword args)))
  65     (if (and keyword-value (>= (length keyword-value) 2))
  66         (cadr keyword-value)
  67         default)))
  68
  69 (define (create-job . rest)
  70   (let ((command-line  (get-keyword-value rest #:command-line  #f))
  71         (args          (get-keyword-value rest #:args          (list)))
  72         (start-trigger (get-keyword-value rest #:start-trigger 'login))
  73         (end-trigger   (get-keyword-value rest #:end-trigger   #f))
  74         (name          (get-keyword-value rest #:name          "default"))
  75         (redirect      (get-keyword-value rest #:redirect      #f)))
  76     ;; do thing with keyword-ed variables
  77     ;; (display "settings:") (newline)
  78     ;; (format (current-output-port)
  79     ;;         "command-line:~a" command-line)
  80     ;; (newline)
  81     ;; (format (current-output-port)
  82     ;;         "args:~a" args)
  83     ;; (newline)
  84     ;; (format (current-output-port)
  85     ;;         "start-trigger:~a" start-trigger)
  86     ;; (newline)
  87     ;; (format (current-output-port)
  88     ;;         "end-trigger:~a" end-trigger)
  89     ;; (newline)
  90
  91     ;; create a new object that represents the args given.
  92     (make-job name
  93               command-line
  94               args
  95               start-trigger
  96               end-trigger
  97               redirect)
  98     ))