blob: 60220dc7282112988b51392a44595e9e94e195bc (
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
|
;;; -*- lexical-binding: t -*-
(defcustom grid-engine-map nil
"Keymap for Grid Engine mode.")
(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.")
(defun grid-engine-setup ()
(if grid-engine-map
nil
(setq grid-engine-map (make-keymap))
;; disable all key bindings
(suppress-keymap grid-engine-map)
(define-key grid-engine-map (kbd "n") 'next-logical-line)
(define-key grid-engine-map (kbd "p") 'previous-logical-line)
(define-key grid-engine-map (kbd "q") 'bury-buffer)
(define-key grid-engine-map (kbd "<RET>")
(lambda (&optional arg)
(interactive)
(let ((field (get-text-property (point) 'field))
(job (get-text-property (point) 'grid-engine-job)))
(unless (and field job)
(error "[Grid Engine] point is not on a field of a job record"))
(grid-engine-job-details field job arg))))
(define-key grid-engine-map (kbd "g")
(lambda () (interactive) (grid-engine-list-jobs)))))
(defun grid-engine--raise-buffer (&optional buffer)
(when buffer
(set-buffer buffer))
(goto-char (point-min))
(pop-to-buffer-same-window (current-buffer))
(grid-engine))
(defun grid-engine--split-buffer (&optional buffer)
(when buffer
(set-buffer buffer))
(goto-char (point-min))
(display-buffer (current-buffer))
(grid-engine))
(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."
(setq columns '((job-id . ("Job-ID" "%-10s"))
(priority . ("Priority" "%-10s"))
(name . ("Job name" "%-10s"))
(owner . ("User" "%-15s"))
(state . ("State" "%-15s"))
(time . ("Time" "%-25s"))
(queue . ("Queue" "%-25s"))
(slots . ("Slots" "%-10s"))))
(setq column-order '(job-id time priority owner state))
(setq row-fmt (concat (mapconcat (lambda (key)
(caddr (assoc key columns)))
column-order " ")
"\n"))
(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 format-job-record (job)
(let* ((args (cons row-fmt (mapcar (lambda (key)
(field-as-text key job))
column-order)))
(text (apply 'format args)))
(propertize text 'grid-engine-job job)))
(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))
(erase-buffer)
;; insert header
(insert (apply 'format
(cons row-fmt
(mapcar (lambda (key)
(cadr (assoc key columns)))
column-order))))
;; insert separator
(insert " \n")
;; insert each row
(mapcar (lambda (job)
(insert (format-job-record job)))
jobs))
(grid-engine--raise-buffer)
(message nil)))
(defun grid-engine-job-details (field 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)))
(defun grid-engine ()
"Major mode for interacting with Grid Engine."
(interactive)
(kill-all-local-variables)
(setq major-mode 'grid-engine)
(setq mode-name "Grid Engine")
(grid-engine-setup)
(use-local-map grid-engine-map)
(run-hooks 'grid-engine-hook))
(provide 'grid-engine-mode)
|
