1 | (defun write-data (&key (file "build-metrics.data")) |
---|
2 | (let ((results (nreverse (parse)))) |
---|
3 | (format t "Writing gnuplot file to ~A.~%" file) |
---|
4 | (with-open-file (s file :direction :output :if-exists :supersede) |
---|
5 | (format s "# hg-changeset-number svn-revision date abcl.jar-size user-build-time~%") |
---|
6 | (dolist (line results) |
---|
7 | (format s "~A~%" line))))) |
---|
8 | |
---|
9 | (defun parse (&key (file "build-metrics.out")) |
---|
10 | (let (result) |
---|
11 | (format t "Reading raw build metrics from ~A.~%" file) |
---|
12 | (with-open-file (s file) |
---|
13 | (loop |
---|
14 | (when (eq (peek-char nil s nil 'EOF) 'EOF) |
---|
15 | (return result)) |
---|
16 | (let ((record (read-record s))) |
---|
17 | (when (null record) |
---|
18 | (return result)) |
---|
19 | (flet ((get-value (key) |
---|
20 | (cdr (assoc key record :test 'equal)))) |
---|
21 | (unless (string-equal (get-value "BUILD") |
---|
22 | "FAILED") |
---|
23 | (let ((changeset (get-value "changeset")) |
---|
24 | (date (get-value "date")) |
---|
25 | (svn (get-value "svn"))) |
---|
26 | ;;; Just include the part before the colon |
---|
27 | (setf changeset (subseq changeset |
---|
28 | 0 (search ":" changeset))) |
---|
29 | ;;; Just include the day |
---|
30 | (setf date (subseq date |
---|
31 | 0 (search " " date))) |
---|
32 | ;;; String the preceeding "r" |
---|
33 | (setf svn (subseq svn 1)) |
---|
34 | (push (format nil "~A ~A ~A ~A ~A" |
---|
35 | changeset |
---|
36 | svn |
---|
37 | date |
---|
38 | (get-value "abcl.jar-size") |
---|
39 | (get-value "user")) |
---|
40 | result))))))))) |
---|
41 | |
---|
42 | (defun read-record (s) |
---|
43 | (let (result) |
---|
44 | (handler-case |
---|
45 | (let ((begin (read-line s))) |
---|
46 | (unless (string-equal begin "-----") |
---|
47 | (error "Stream ~a not at beginning of record: ~a" s begin)) |
---|
48 | (loop |
---|
49 | (when (equal (peek-char nil s) #\-) (return-from read-record result)) |
---|
50 | (let* ((line (read-line s)) |
---|
51 | (space (search " " line))) |
---|
52 | (when (numberp space) |
---|
53 | (let ((key (subseq line 0 space)) |
---|
54 | (value (subseq line (1+ space)))) |
---|
55 | (when (equal #\: (char key (1- (length key)))) |
---|
56 | (setf key (subseq key 0 (1- (length key))))) |
---|
57 | (push (cons key value) result))))) |
---|
58 | result) |
---|
59 | (end-of-file () (return-from read-record result))))) |
---|
60 | |
---|
61 | |
---|
62 | |
---|
63 | |
---|
64 | |
---|
65 | |
---|
66 | |
---|