Overview
Context
Changes
Modified dashboard-tests.scm
from [bce95a595d]
to [9124f50a29].
︙ | | |
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
|
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
|
-
+
+
|
;;======================================================================
;;
;;======================================================================
(define (examine-test run-id test-id) ;; run-id run-key origtest)
(let* ((db-path (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db"))
(dbstruct (make-dbr:dbstruct path: (configf:lookup *configdat* "setup" "linktree") local: #t))
(dbstruct (make-dbr:dbstruct path: (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree")
local: #t))
(testdat (db:get-test-info-by-id dbstruct run-id test-id))
(db-mod-time 0) ;; (file-modification-time db-path))
(last-update 0) ;; (current-seconds))
(request-update #t))
(if (not testdat)
(begin
(debug:print 2 "ERROR: No test data found for test " test-id ", exiting")
|
︙ | | |
Modified dashboard.scm
from [3787336c4d]
to [7571891dc8].
︙ | | |
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
-
+
|
(exit)))
(if (not (launch:setup-for-run))
(begin
(print "Failed to find megatest.config, exiting")
(exit 1)))
(define *dbdir* (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(define *dbstruct-local* (make-dbr:dbstruct path: *dbdir*
local: #t))
(define *db-file-path* (db:dbfile-path 0))
;; HACK ALERT: this is a hack, please fix.
(define *read-only* (not (file-read-access? *db-file-path*)))
|
︙ | | |
Modified db.scm
from [b5e5388382]
to [cd6cb3bd8f].
︙ | | |
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
|
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
|
+
-
+
+
-
+
+
+
-
+
+
|
;;
;; ;; Use to get a path. To get an arbitrary string see next define
;; ;;
;; (define (db:get-path dbstruct id)
;; (let ((fdb (db:get-filedb dbstruct)))
;; (filedb:get-path db id)))
;; NB// #f => return dbdir only
;; NB// #f => zeroth db with name=main.db
;; (was planned to be; zeroth db with name=main.db)
;;
(define (db:dbfile-path run-id)
(let* (;; (toppath (dbr:dbstruct-get-path dbstruct))
(link-tree-path (configf:lookup *configdat* "setup" "linktree"))
(dbpath (configf:lookup *configdat* "setup" "dbdir"))
(fname (if run-id
(fname (if (eq? run-id 0) "main.db" (conc run-id ".db")))
(if (eq? run-id 0) "main.db" (conc run-id ".db"))
#f))
(dbdir (if dbpath
dbpath
(conc link-tree-path "/.db/"))))
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: Couldn't create path to " dbdir)
(exit 1))
(if (not (directory? dbdir))(create-directory dbdir #t)))
(if fname
(conc dbdir fname)))
(conc dbdir fname)
dbdir)))
(define (db:set-sync db)
(let ((syncprag (configf:lookup *configdat* "setup" "sychronous")))
(sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 1) ";"))))
;; open an sql database inside a file lock
;;
|
︙ | | |
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
|
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
|
-
+
|
(dbr:dbstruct-set-main! dbstruct dbdat)
(dbr:dbstruct-set-olddb! dbstruct olddb) ;; olddb is already a (cons db path)
dbdat))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
(let* ((dbdir (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(let* ((dbdir (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(dbstruct (make-dbr:dbstruct path: dbdir local: local)))
dbstruct))
;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
(let* ((dbpath (conc *toppath* "/megatest.db"))
|
︙ | | |
Modified newdashboard.scm
from [f36b9c595f]
to [8ecdd4ecf2].
︙ | | |
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
-
+
|
;; (client:launch))
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
(define *dbdir* (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(define *dbstruct-local* (make-dbr:dbstruct path: *dbdir*
local: #t))
(define *db-file-path* (db:dbfile-path 0))
;; HACK ALERT: this is a hack, please fix.
(define *read-only* (not (file-read-access? *db-file-path*)))
|
︙ | | |
Modified rmt.scm
from [fbb21771c9]
to [841f80a9e9].
︙ | | |
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
-
+
|
(loop (car tal)(cdr tal) newmax-cmd currmax)))))))
(mutex-unlock! *db-stats-mutex*)
res))
(define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5))
(let* ((dbstruct-local (if *dbstruct-db*
*dbstruct-db*
(let* ((dbdir (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(let* ((dbdir (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(db (make-dbr:dbstruct path: dbdir local: #t)))
(set! *dbstruct-db* db)
db)))
(db-file-path (db:dbfile-path 0))
;; (read-only (not (file-read-access? db-file-path)))
(start (current-milliseconds))
(resdat (api:execute-requests dbstruct-local (vector (symbol->string cmd) params)))
|
︙ | | |
Modified tasks.scm
from [1ea4ffe4d5]
to [590db5beef].
︙ | | |
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
|
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
|
-
+
|
res))
;;
(define (tasks:start-monitor db mdb)
(if (> (tasks:get-num-alive-monitors mdb) 2) ;; have two running, no need for more
(debug:print-info 1 "Not starting monitor, already have more than two running")
(let* ((megatestdb (conc *toppath* "/megatest.db"))
(monitordbf (conc (configf:lookup *configdat* "setup" "linktree") "/.db/monitor.db"))
(monitordbf (conc (db:dbfile-path #f) "/monitor.db"))
(last-db-update 0)) ;; (file-modification-time megatestdb)))
(task:register-monitor mdb)
(let loop ((count 0)
(next-touch 0)) ;; next-touch is the time where we need to update last_update
;; if the db has been modified we'd best look at the task queue
(let ((modtime (file-modification-time megatestdbpath )))
(if (> modtime last-db-update)
|
︙ | | |
Modified tdb.scm
from [575d5c7ba8]
to [3278a98477].
︙ | | |
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
|
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
|
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
|
;; Create the sqlite db for the individual test(s)
(define (open-test-db work-area)
(debug:print-info 11 "open-test-db " work-area)
(if (and work-area
(directory? work-area)
(file-read-access? work-area))
(let* ((dbpath (conc work-area "/testdat.db"))
(tdb-writeable (file-write-access? dbpath))
(let* ((dbpath (conc work-area "/testdat.db"))
(dbexists (file-exists? dbpath))
(work-area-writeable (file-write-access? work-area))
(dbexists (file-exists? dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000))))
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print 2 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
((condition-property-accessor 'exn 'message) exn))
(set! db (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access
(set! dbexists #f)) ;; must force re-creation of tables, more tom-foolery
(set! db (sqlite3:open-database dbpath)))
(if *db-write-access* (sqlite3:set-busy-handler! db handler))
(db (handle-exceptions ;; open the db if area writeable or db pre-existing. open in-mem otherwise. if exception, open in-mem
exn
(begin
(print-call-chain (current-error-port))
(debug:print 2 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
((condition-property-accessor 'exn 'message) exn))
(set! dbexists #f) ;; must force re-creation of tables, more tom-foolery
(sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access
(if (or work-area-writeable
dbexists)
(sqlite3:open-database dbpath)
(sqlite3:open-database ":memory:"))))
(tdb-writeable (and (file-write-access? work-area)
(file-write-access? dbpath)))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000))))
(if (and tdb-writeable
*db-write-access*)
(sqlite3:set-busy-handler! db handler))
(if (not dbexists)
(begin
(db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = FULL;")
(debug:print-info 11 "Initialized test database " dbpath)
(tdb:testdb-initialize db)))
;; (sqlite3:execute db "PRAGMA synchronous = 0;")
(debug:print-info 11 "open-test-db END (sucessful)" work-area)
;; now let's test that everything is correct
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print 0 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file "
dbpath ".\n "
((condition-property-accessor 'exn 'message) exn))
#f)
;; Is there a cheaper single line operation that will check for existance of a table
;; and raise an exception ?
(sqlite3:execute db "SELECT id FROM test_data LIMIT 1;"))
db)
(let ((baddb (sqlite3:open-database ":memory:")))
(debug:print-info 11 "open-test-db END (unsucessful)" work-area)
;; provide an in-mem db (this is dangerous!)
(tdb:testdb-initialize baddb)
baddb)))
db)))
;; (let ((baddb (sqlite3:open-database ":memory:")))
;; (debug:print-info 11 "open-test-db END (unsucessful)" work-area)
;; ;; provide an in-mem db (this is dangerous!)
;; (tdb:testdb-initialize baddb)
;; baddb)))
;; find and open the testdat.db file for an existing test
(define (tdb:open-test-db-by-test-id test-id #!key (work-area #f))
(let* ((test-path (if work-area
work-area
(rmt:test-get-rundir-from-test-id test-id))))
(debug:print 3 "TEST PATH: " test-path)
|
︙ | | |