1
2
3
4
5
6
7
8
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest 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 3 of the License, or
|
|
|
1
2
3
4
5
6
7
8
|
>;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest 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 3 of the License, or
|
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
|
(declare (uses debugprint))
;; (declare (uses common))
(declare (uses keys))
(declare (uses mt))
(declare (uses commonmod))
(declare (uses mtargs))
(declare (uses rmtmod))
(require-extension (srfi 18) extras tcp)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(import commonmod
debugprint
rmtmod
(prefix mtargs args:))
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")
(include "run_records.scm")
;;======================================================================
;;
;; T E S T D A T A B A S E S
;;
;;======================================================================
;;======================================================================
;; T E S T S P E C I F I C D B
;;======================================================================
;; =not-used= ;; Create the sqlite db for the individual test(s)
;; =not-used= ;;
;; =not-used= ;; Moved these tables into <runid>.db
;; =not-used= ;; THIS CODE TO BE REMOVED
;; =not-used= ;;
;; =not-used= (define (open-test-db work-area)
|
>
>
>
>
>
>
>
>
>
|
>
>
|
>
>
>
>
>
>
>
>
>
|
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
|
(declare (uses debugprint))
;; (declare (uses common))
(declare (uses keys))
(declare (uses mt))
(declare (uses commonmod))
(declare (uses mtargs))
(declare (uses rmtmod))
(module tdb
*
(import scheme
chicken
data-structures
)
(require-extension (srfi 18) extras tcp)
(import srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5
message-digest base64)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(import commonmod
debugprint
rmtmod
(prefix mtargs args:))
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")
;; (include "run_records.scm")
;;======================================================================
;;
;; T E S T D A T A B A S E S
;;
;;======================================================================
;;======================================================================
;; T E S T S P E C I F I C D B
;;======================================================================
;; (define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
;; (assert (number? run-id) "FATAL: Run id required.")
;; (let* ((test-path (if (string? work-area)
;; work-area
;; (rmt:test-get-rundir-from-test-id run-id test-id))))
;; (debug:print 3 *default-log-port* "TEST PATH: " test-path)
;; (open-test-db test-path)))
;; =not-used= ;; Create the sqlite db for the individual test(s)
;; =not-used= ;;
;; =not-used= ;; Moved these tables into <runid>.db
;; =not-used= ;; THIS CODE TO BE REMOVED
;; =not-used= ;;
;; =not-used= (define (open-test-db work-area)
|
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
(rmt:csv->test-data run-id test-id lin)
;;)
(loop (read-line)))))
;; roll up the current results.
;; FIXME: Add the status too
(rmt:test-data-rollup run-id test-id #f))
;; NOTE: Run this local with #f for db !!!
(define (tdb:load-logpro-data run-id test-id)
(let loop ((lin (read-line)))
(if (not (eof-object? lin))
(begin
(debug:print 4 *default-log-port* lin)
;;(when lin ;; this when blocked stack dump caused by .dat file from logpro being 0-byte. fixed by upgrading logpro
(rmt:csv->test-data run-id test-id lin)
;;)
(loop (read-line)))))
;; roll up the current results.
;; FIXME: Add the status too
(rmt:test-data-rollup run-id test-id #f))
;;======================================================================
;; S T E P S
;;======================================================================
(define (tdb:step-get-time-as-string vec)
(seconds->time-string (tdb:step-get-event_time vec)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
|
(rmt:csv->test-data run-id test-id lin)
;;)
(loop (read-line)))))
;; roll up the current results.
;; FIXME: Add the status too
(rmt:test-data-rollup run-id test-id #f))
;; ;; NOTE: Run this local with #f for db !!!
;; (define (tdb:load-logpro-data run-id test-id)
;; (let loop ((lin (read-line)))
;; (if (not (eof-object? lin))
;; (begin
;; (debug:print 4 *default-log-port* lin)
;; ;;(when lin ;; this when blocked stack dump caused by .dat file from logpro being 0-byte. fixed by upgrading logpro
;; (rmt:csv->test-data run-id test-id lin)
;; ;;)
;; (loop (read-line)))))
;; ;; roll up the current results.
;; ;; FIXME: Add the status too
;; (rmt:test-data-rollup run-id test-id #f))
;;======================================================================
;; S T E P S
;;======================================================================
(define (tdb:step-get-time-as-string vec)
(seconds->time-string (tdb:step-get-event_time vec)))
|
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
(if (eq? time-a time-b)
(string<? (conc (vector-ref a 2))
(conc (vector-ref b 2)))
#f))
(string<? (conc time-a)(conc time-b))))))))
;;
(define (tdb:remote-update-testdat-meta-info run-id test-id work-area cpuload diskfree minutes)
(let ((tdb (rmt:open-test-db-by-test-id run-id test-id work-area: work-area)))
(if (sqlite3:database? tdb)
(begin
(sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);"
cpuload diskfree minutes)
(sqlite3:finalize! tdb))
(debug:print 2 *default-log-port* "Can't update testdat.db for test " test-id " read-only or non-existant"))))
|
|
>
|
|
|
|
|
|
|
>
|
|
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
|
(if (eq? time-a time-b)
(string<? (conc (vector-ref a 2))
(conc (vector-ref b 2)))
#f))
(string<? (conc time-a)(conc time-b))))))))
;;
;; (define (tdb:remote-update-testdat-meta-info run-id test-id work-area
;; cpuload diskfree minutes)
;; (let ((tdb (rmt:open-test-db-by-test-id run-id test-id work-area: work-area)))
;; (if (sqlite3:database? tdb)
;; (begin
;; (sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);"
;; cpuload diskfree minutes)
;; (sqlite3:finalize! tdb))
;; (debug:print 2 *default-log-port* "Can't update testdat.db for test " test-id " read-only or non-existant"))))
;;
)
|