blob: fd6871938808333e306521731fe0eedcb014ce28 (
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
|
#!/usr/local/bin/txr --lisp
(defvarl %prog% *load-path*)
(defvar *gerrit-curl*)
(defstruct patch-set ()
num
(files (hash)))
(defstruct file ()
path
(comments (vec)))
(defstruct comment ()
line
chr
unresolved
user
name
lines)
(defun fatal (. args)
[apply format t `@{%prog%}: @(car args)\n` (cdr args)]
(exit nil))
(defun gerrit-config (user-id password server)
(if (contains ":" user-id)
(error "user-id ~a may not have a \":\" (colon) in it." user-id))
(set *gerrit-curl* `curl -H Accept-Encoding:gzip \ \
-s -k -u @{user-id}:@{password} @{server}`))
(defun gerrit (api)
(unless *gerrit-curl*
(error "~s: configure with gerrit-config function" 'gerrit))
(with-stream (s (open-command `@{*gerrit-curl*}@api` "rz"))
(let ((tag (get-line s)))
(if (nequal tag ")]}'")
(fatal "error response from server: ~a" tag)))
(get-json s)))
(defun get-gerrit-comments (change-id : resolved-too)
(let ((ps-hash (hash)))
(dohash (path comments
(catch
(gerrit `/a/changes/@{change-id}/comments/`)
(syntax-error (. rest)
(fatal `error retrieving Change-Id: @{change-id}`)))
ps-hash)
(each ((cmt comments))
(let ((unresolved [cmt "unresolved"]))
(when (or unresolved resolved-too)
(let* ((line (int-flo (or [cmt "line"] 0.0)))
(rng [cmt "range"])
(endchr [rng "end_character"])
(ps-num (int-flo [cmt "patch_set"]))
(auth [cmt "author"])
(name [auth "name"])
(username [auth "username"])
(unresolved [cmt "unresolved"])
(lines (spl "\n" [cmt "message"]))
(patch-set (or [ps-hash ps-num]
(set [ps-hash ps-num]
(new patch-set num ps-num))))
(file (or [patch-set.files path]
(set [patch-set.files path]
(new file path path)))))
(vec-push file.comments
(new comment
line line
chr endchr
unresolved unresolved
user username
name name
lines lines)))))))))
(defun print-as-errors (patchset)
(put-line `comments from patch set @{patchset.num}`)
(each ((file (sort (hash-values patchset.files) : .path)))
(each ((cmt file.comments))
(put-line `@{file.path}:@{cmt.line}:\
@(if cmt.chr `@{cmt.chr}:`) \ \
@(if cmt.unresolved "un")resolved comment by\ \
@{cmt.name} (@{cmt.user})`)
(each ((ln cmt.lines))
(put-line `\t@ln`)))))
(define-option-struct opts ()
(nil help :bool "List this help text.")
(p patchset :str "Patchset selection. Valid choices are all,\ \
highest or a positive decimal integer\ \
with no leading zeros. Default is all.")
(r resolved :bool "Resolved comments too.")
(s server :str "URL of gerrit server, with no trailing slash:\ \
for example, https://example.com/gerrit .\ \
May be given via GER2ERR_SERVER\ \
environment variable.")
(u userid :str "HTTP user ID for Gerrit\ \
(Different from regular Gerrit user ID).\ \
May be given via GER2ERR_USERID\ \
environment variable.")
(w password :str "HTTP password for Gerrit\ \
(Different from regular Gerrit password;\ \
generated in Gerrit config GUI).\ \
May be given via GER2ERR_PASSWORD\ \
environment variable."))
(catch
(let ((o (new opts))
(ps-sel :all))
o.(getopts *args*)
(when o.help
(put-line `\nUsage:\n\n @{%prog%} [options] change-id`)
o.(opthelp)
(exit nil))
(match-case o.patchset
(nil)
("all" (set ps-sel :all))
("highest" (set ps-sel :highest))
(`@{num #/[1-9][0-9]*/}` (set ps-sel (int-str num)))
(@else (fatal "bad argument to --patchset")))
(gerrit-config (or o.userid
(getenv "GER2ERR_USERID")
(fatal "userid required"))
(or o.password
(getenv "GER2ERR_PASSWORD")
(fatal "password required"))
(or o.server
(getenv "GER2ERR_SERVER")
(fatal "server URL required")))
(match-case o.out-args
((@change-id) (let ((ps-hash (get-gerrit-comments change-id o.resolved)))
(match-case ps-sel
(@(or (integerp @psnum)
@(and :highest
@(with psnum [find-max-key ps-hash : car])))
(print-as-errors [ps-hash psnum]))
(@else
(each ((psnum (sort (hash-keys ps-hash))))
(print-as-errors [ps-hash psnum]))))))
(@else (fatal "change-id argument required: use --help for usage."))))
(opt-error (msg)
(fatal msg)))
|
