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 |
11e636da | 26 | job-redirect c-job-redirect |
8c4961ec | 27 | c-check-job)) |
4f839c09 TB |
28 | |
29 | ;;; records | |
30 | (define-record-type <job> | |
11e636da | 31 | (make-job name command-line args start-trigger end-trigger redirect) |
4f839c09 | 32 | job? |
06570394 | 33 | (name job-name) |
4f839c09 TB |
34 | (command-line job-command-line) |
35 | (args job-args) | |
36 | (start-trigger job-start-trigger) | |
11e636da TB |
37 | (end-trigger job-end-trigger) |
38 | (redirect job-redirect)) | |
4f839c09 | 39 | |
8c4961ec TB |
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 | ||
06570394 TB |
56 | (define (c-job-name obj) |
57 | (job-name obj)) | |
58 | ||
11e636da TB |
59 | (define (c-job-redirect obj) |
60 | (job-redirect obj)) | |
61 | ||
4f839c09 TB |
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)) | |
06570394 | 73 | (end-trigger (get-keyword-value rest #:end-trigger #f)) |
11e636da TB |
74 | (name (get-keyword-value rest #:name "default")) |
75 | (redirect (get-keyword-value rest #:redirect #f))) | |
4f839c09 | 76 | ;; do thing with keyword-ed variables |
8c4961ec TB |
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) | |
4f839c09 TB |
90 | |
91 | ;; create a new object that represents the args given. | |
06570394 TB |
92 | (make-job name |
93 | command-line | |
4f839c09 TB |
94 | args |
95 | start-trigger | |
11e636da TB |
96 | end-trigger |
97 | redirect) | |
4f839c09 | 98 | )) |