blob: 5fa6122dc96e5e3a0ef4f60392c8c93d004532e5 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
;;; -*- lexical-binding: t -*-
(require 'derived)
(define-derived-mode grid-engine-list-mode
tabulated-list-mode "Grid Engine"
"Major mode for interacting with Grid Engine.
\\{grid-engine-mode-list-mode-map}"
(interactive)
(kill-all-local-variables)
(setq major-mode 'grid-engine-list-mode)
(setq mode-name "Grid Engine")
(grid-engine--init-keymap)
(grid-engine--init-header)
(add-hook 'tabulated-list-revert-hook
(lambda ()
(grid-engine--init-header)
(grid-engine-list-jobs)))
(use-local-map grid-engine-list-mode-map)
(run-hooks 'grid-engine-hook))
(defcustom grid-engine-host nil
"The host on which Grid Engine is running. Defaults to localhost.")
(defcustom grid-engine-qstat "/opt/sge/bin/lx-amd64/qstat"
"The full path to the qstat executable.")
(defcustom grid-engine-user nil
"The grid engine user. Defaults to the logged in user's name.")
(defcustom grid-engine-column-order '(job-id time priority owner state)
"The order of job columns to be displayed. The following keys are valid: job-id, priority, name, owner, state, time, queue, slots.")
(defun grid-engine--init-keymap ()
(setq grid-engine-list-mode-map (make-keymap))
;; disable all key bindings
(suppress-keymap grid-engine-list-mode-map)
(define-key grid-engine-list-mode-map (kbd "n") 'next-logical-line)
(define-key grid-engine-list-mode-map (kbd "p") 'previous-logical-line)
(define-key grid-engine-list-mode-map (kbd "q") 'bury-buffer)
(define-key grid-engine-list-mode-map (kbd "g") 'revert-buffer)
(define-key grid-engine-list-mode-map (kbd "<RET>")
(lambda (&optional arg)
(interactive "P")
(let ((job (get-text-property (point) 'tabulated-list-id)))
(unless job
(error "[Grid Engine] point is not on a field of a job record"))
(grid-engine-job-details job arg)))))
(defun grid-engine--init-header ()
(grid-engine-update-list-format)
(tabulated-list-init-header))
(defun grid-engine-update-list-format ()
"Compute value of tabulated-list-format from grid-engine-column-order."
(setq columns '((job-id . ("Job-ID" 10 t))
(priority . ("Priority" 10 t))
(name . ("Job name" 10 t))
(owner . ("User" 15 t))
(state . ("State" 15 t))
(time . ("Time" 25 t))
(queue . ("Queue" 25 t))
(slots . ("Slots" 10 t))))
(setq tabulated-list-format
(vconcat (mapcar (lambda (key)
(cdr (assoc key columns)))
grid-engine-column-order))))
(defun grid-engine--raise-buffer (&optional buffer mode)
(when buffer
(set-buffer buffer))
(goto-char (point-min))
(pop-to-buffer-same-window (current-buffer))
(when mode
(funcall mode)))
(defun grid-engine--split-buffer (&optional buffer mode)
(when buffer
(set-buffer buffer))
(goto-char (point-min))
(display-buffer (current-buffer))
(when mode
(funcall mode)))
(defun grid-engine--default-directory ()
(if grid-engine-host
(concat "/ssh:" grid-engine-host ":")
default-directory))
(defun grid-engine--cmd-to-buffer (cmd &optional buffer-name)
"Run a command CMD on the Grid Engine host and write output to BUFFER-NAME. If BUFFER-NAME is nil, write to current buffer."
(let ((default-directory (grid-engine--default-directory)))
(when buffer-name
(set-buffer (get-buffer-create buffer-name))
(erase-buffer))
(process-file-shell-command cmd nil (current-buffer) t)))
(defun grid-engine--cmd-to-xmltree (cmd)
"Run a command CMD on the Grid Engine host and return output as list of strings."
(with-temp-buffer
(grid-engine--cmd-to-buffer cmd)
(libxml-parse-xml-region 1 (buffer-size))))
(defun grid-engine-list-jobs ()
"List all jobs for the specified user in a new buffer."
(defun field-as-text (field obj &optional format-string)
(let* ((value (cdr (assoc field obj)))
(format-string (if format-string format-string
"%s"))
(text (format format-string value)))
(propertize text 'field value)))
(defun job-to-row (job)
(let ((contents (vconcat (mapcar (lambda (key)
(field-as-text key job))
grid-engine-column-order))))
(list job contents)))
(defun mkjob-alist (subtree)
"Convert a parsed XML subtree for a job entry to an alist."
(cl-reduce
(lambda (acc field)
(let ((name (case (car field)
('JB_job_number 'job-id)
('JAT_prio 'priority)
('JB_name 'name)
('JB_owner 'owner)
('state 'state)
('JAT_start_time 'time)
('queue_name 'queue)
('slots 'slots)
(t nil))))
(if name
(cons (cons name (caddr field)) acc)
acc)))
(cdr subtree) :initial-value nil))
(let* ((user (if grid-engine-user grid-engine-user
(user-login-name)))
(cmd (concat grid-engine-qstat " -xml -u " user))
(title "*grid-engine-jobs*"))
(message "[Grid Engine] fetching list of jobs for %s ..." user)
(let* ((tree (grid-engine--cmd-to-xmltree cmd))
(jobs (mapcar 'mkjob-alist (cddr (caddr tree)))))
(set-buffer (get-buffer-create title))
(setq tabulated-list-entries
(mapcar (lambda (job)
(job-to-row job))
jobs)))
(grid-engine--raise-buffer nil 'grid-engine-list-mode)
;; update list
(tabulated-list-print)
(message nil)))
(defun grid-engine-job-details (job &optional new-buffer)
(let* ((job-id (cdr (assoc 'job-id job)))
(cmd (concat grid-engine-qstat " -j " job-id))
(title (if new-buffer
(concat "*grid-engine-job-details-" job-id "*")
"*grid-engine-job-details*")))
(message "[Grid Engine] fetching details for job %s" job-id)
(grid-engine--cmd-to-buffer cmd title)
(grid-engine--split-buffer)))
(provide 'grid-engine-mode)
|
