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