summaryrefslogtreecommitdiff
path: root/grid-engine-mode.el
blob: 73c9c9dd89734a5a5620d08c115eadf2748e32fa (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
;;; -*- 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)
        (grid-engine-job-details (thing-at-point 'word) 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 row-pattern "%-10s %-10s %-15s %-10s\n")
  (setq header (format (concat row-pattern "\n")
                       "Job-ID"
                       "Priority"
                       "User"
                       "State"))
  (defun format-job-record (job)
    (format row-pattern
            (cdr (assoc 'job-id   job))
            (cdr (assoc 'priority job))
            (cdr (assoc 'owner    job))
            (cdr (assoc 'state    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)
      (mapcar (lambda (job)
                (insert (format-job-record job)))
              jobs))
    (grid-engine--raise-buffer)
    (message nil)))

(defun grid-engine-job-details (job-id &optional new-buffer)
;  (unless (number-or-marker-p job-id)
;    (error "[Grid Engine] %s is not a valid job id."))
  (let ((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))