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
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
;; Routines to do devscripts-compatible emacs routines.
;; copyright 2002 Junichi Uekawa.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; readme-debian.el is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with your Debian installation, in /usr/share/common-licenses/GPL
;; If not, write to the Free Software Foundation, 675 Mass Ave,
;; Cambridge, MA 02139, USA.
(require 'mcharset)
(defgroup pbuilder-log-view nil "Pbuilder log view mode"
:group 'tools
:prefix "pbuilder-log-view-")
(defcustom pbuilder-log-view-web-basepath "/~pbuilder/" "*Elserv path to pbuilder logs."
:type 'string
:group 'pbuilder-log-view)
(defvar pbuilder-log-view-build-result-alist nil
"Associated list of results of the pbuilder/debuild runs.
They are in (package result-buffer-name process-name(if process exists))
When this variable is being accessed, set `pbuilder-log-view-build-result-alist-mutex' to t.")
(defvar pbuilder-log-view-build-result-alist-mutex nil
"The access-control for `pbuilder-log-view-build-result-alist'.
If someone is accessing that var, it is t")
;; potential new interface?
(defvar pbuilder-log-view-results-plist nil
"Property list of results of the pbuilder/debuild runs.
:package
:result-buffer-name
:process-name")
;; mutex lock implementation thanks to TSUCHIYA Masatoshi
(defmacro pbuilder-log-view-lock-mutex (mutex &rest body)
"Try to mutex-lock a variable MUTEX, and run BODY.
The MUTEX needs to be nil."
`(progn
(while ,mutex
(accept-process-output nil 0 200))
(setq ,mutex t)
,@body
(setq ,mutex nil)))
;; The following code does publishing for elserv.
;; elserv-start, then run pbuilder-log-view-elserv
(defun pbuilder-log-view-add (package-name buffer-name running-process)
"Add the entry to the log view list.
\(PACKAGE-NAME, BUFFER-NAME, RUNNING-PROCESS\) will be added to
`pbuilder-log-view-build-result-alist'.
Argument PACKAGE-NAME is the name of the package."
(pbuilder-log-view-lock-mutex
pbuilder-log-view-build-result-alist-mutex
(add-to-list 'pbuilder-log-view-build-result-alist (list package-name buffer-name running-process))))
(defun pbuilder-log-view-internal-garbage-collect-log ()
"Remove unneeded entries from the log listing."
(setq pbuilder-log-view-build-result-alist
(let* (new-data current-is-okay)
(dolist (entry pbuilder-log-view-build-result-alist)
(setq current-is-okay t)
(if (get-buffer (cadr entry))
(dolist (new-data-element new-data)
(if (string= (cadr new-data-element) (cadr entry))
(setq current-is-okay nil))
(if (string= (car new-data-element) (car entry))
(setq current-is-okay nil)))
(setq current-is-okay nil))
(if current-is-okay
(add-to-list 'new-data entry)))
(reverse new-data))))
(defun pbuilder-log-view-internal-view-one-log (result path ppath request)
"View one logfile from buffer.
Requires a newish htmlize.el
RESULT is the resulting value
PATH is relative path from the published path
PPATH is the published path
REQUEST is the request data."
(let* (logname matching-assoc nowlist charset)
(string-match "/\\?\\(.+\\).html$" path)
(setq logname (match-string 1 path))
(setq nowlist (assoc logname pbuilder-log-view-build-result-alist))
(if nowlist
(save-window-excursion
(if (get-buffer (cadr nowlist))
(progn
(let* ((htmlize-major-mode nil))
(set-buffer (htmlize-buffer-noninteractive (cadr nowlist))))
(setq charset (detect-mime-charset-region (point-min)(point-max)))
(elserv-set-result-header
result
(list 'content-type (concat "text/html; charset=" (symbol-name charset))))
(elserv-set-result-body result
(encode-mime-charset-string (buffer-string) charset))
(kill-buffer (current-buffer)))
(elserv-set-result-header result (list 'content-type (concat "text/plain")))
(elserv-set-result-body result "404?")))
(elserv-set-result-header result (list 'content-type (concat "text/plain")))
(elserv-set-result-body result "404p"))))
;; some code sampled from remote.el from elserv sources.
(defun pbuilder-log-view-internal-function (result path ppath request)
"Elserv publish function for pbuilder logs.
RESULT, PATH, PPATH and REQUEST are arguments
This page presents the list of build logs available from this Emacs session"
(pbuilder-log-view-lock-mutex
pbuilder-log-view-build-result-alist-mutex
(pbuilder-log-view-internal-garbage-collect-log))
(save-window-excursion
(with-temp-buffer
(elserv-set-result-header result
'(content-type "text/html"))
(insert (concat "
<html>
<head>
<title>List of builds</title>
<style type=\"text/css\">"
pbuilder-log-view-css
"</style>
</head>
<body>
<h1 class=\"title\">List of builds done in the emacs session</h1>
<div class=\"listing\"><ul class=\"listing\">
"))
(pbuilder-log-view-lock-mutex
pbuilder-log-view-build-result-alist-mutex
(dolist (nowlist pbuilder-log-view-build-result-alist)
(if (get-buffer (cadr nowlist))
(let* ((running-status
(if (caddr nowlist) (symbol-name (process-status (caddr nowlist)))
"nil")))
(insert (concat "<li class=\"package\"><a class=\"package\" href=\""
pbuilder-log-view-web-basepath "query.cgi/?" (car nowlist) ".html\">"
(car nowlist)
"</a> <span class=\"status\">"
running-status
(if (string= running-status "exit")
(if (= (process-exit-status (caddr nowlist)) 0)
": <span class=\"buildsuccess\">Successful build</span>"
": <span class=\"buildfail\">Build failure</span>")
"")
"</span></li>\n")))))
(insert (concat "</ul></div><p>Last updated:"
(current-time-string)
"</p></body>\n"))
(elserv-set-result-body
result
(buffer-string))))))
(defcustom pbuilder-log-view-css "
BODY{
color: #ffeeee;
background-color: #000055;
}
h1.title{
margin-top: 0em;
border-color: #99c;
border-width: 0px 9px 4px 0px;
border-style: solid;
}
div.listing{
margin-top: 0em;
border-color: #99c;
border-width: 0px 0px 4px 9px;
border-style: solid;
}
li.package{
}
a:link {
color: #ffccff;
}
a:active {
color: #eeeeee;
}
a:hover {
color: #ffffff;
background-color: #5555ff;
}
a:visited {
color: #ddeedd;
}
span.status{
color: #ffffff;
background-color: #000000;
}
span.buildfail{
color: #ff3300;
background-color: #000000;
}
span.buildsuccess{
color: #00aaff;
background-color: #000000;
}
" "*Css-string to be added to pbuilder log listing view html page.
h1.title
div.listing
ul.listing
li.package
a.package
span.status
span.buildfail
span.buildsuccess"
:type 'text
:group 'pbuilder-log-view)
(defun pbuilder-log-view-elserv ()
"Run a elserv session with log view.
Running this requires elserv. Use elserv, and do `elserv-start' before invoking this command."
(interactive)
(require 'elserv)
(require 'htmlize)
(elserv-publish (elserv-find-process)
pbuilder-log-view-web-basepath
:function 'pbuilder-log-view-internal-function
:description "Build log listing"
)
(elserv-publish (elserv-find-process)
(concat pbuilder-log-view-web-basepath "query.cgi")
:function 'pbuilder-log-view-internal-view-one-log
:description "Build log database query"))
(provide 'pbuilder-log-view-mode)
|
