| ︙ | | |
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
-
+
+
+
|
(dir-writable (file-write-access? parent-dir)))
(if dir-writable
(let ((exists (file-exists? fname))
(lock (obtain-dot-lock fname 1 5 10))
(db (sqlite3:open-database fname)))
(sqlite3:set-busy-handler! db (make-busy-timeout 136000))
(db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = 0;")
(if (not exists)(initproc db))
(if (not exists)
(initproc db)
(initproc db update-only: #t))
(release-dot-lock fname)
db)
(begin
(debug:print 0 "ERROR: no such db in non-writable dir " fname)
(sqlite3:open-database fname))))))
;; This routine creates the db. It is only called if the db is not already opened
|
| ︙ | | |
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
|
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
|
do-not-open)
rdb
(let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
(dbexists (file-exists? dbpath))
(inmem (if local #f (db:open-inmem-db)))
(refdb (if local #f (db:open-inmem-db)))
(db (db:lock-create-open dbpath ;; this is the database physically on disk
(lambda (db)
(handle-exceptions
exn
(begin
(release-dot-lock dbpath)
(if (> attemptnum 2)
(debug:print 0 "ERROR: tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath)
(db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1))))
(db:initialize-run-id-db db)
(sqlite3:execute
db
"INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
(* run-id 30000) ;; allow for up to 30k tests per run
run-id)
;; do a dummy query to test that the table exists and the db is truly readable
(sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000))
)))) ;; add strings db to rundb, not in use yet
|
| ︙ | | |
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
|
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
|
-
-
-
+
+
+
|
;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
(let* ((dbpath (conc *toppath* "/megatest.db"))
(dbexists (file-exists? dbpath))
(db (db:lock-create-open dbpath
(lambda (db)
(db:initialize-main-db db)
(db:initialize-run-id-db db))))
(lambda (db update-only)
(db:initialize-main-db db update-only)
(db:initialize-run-id-db db update-only))))
(write-access (file-write-access? dbpath)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(cons db dbpath)))
;; sync run to disk if touched
;;
|
| ︙ | | |
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
|
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
|
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
|
;; (define open-run-close
(define open-run-close open-run-close-exception-handling)
;; open-run-close-no-exception-handling
;; open-run-close-exception-handling)
;;)
(define (db:initialize-main-db dbdat)
(define (db:initialize-main-db dbdat update-only)
(let* ((configdat (car *configinfo*)) ;; tut tut, global warning...
(keys (keys:config-get-fields configdat))
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
(fieldstr (keys->key/field keys))
(db (db:dbdat-get-db dbdat)))
(if (not update-only)
(for-each (lambda (key)
(let ((keyn key))
(if (member (string-downcase keyn)
(list "runname" "state" "status" "owner" "event_time" "comment" "fail_count"
"pass_count"))
(begin
(print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table, you must remove your megatest.db and <linktree>/.db before trying again.")
(exit 1)))))
keys)
|
| ︙ | | |
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
|
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
|
-
+
+
+
+
+
+
+
+
+
|
(sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" "MEGATEST_VERSION" megatest-version)
(debug:print-info 11 "db:initialize END")))))
;;======================================================================
;; R U N S P E C I F I C D B
;;======================================================================
(define (db:initialize-run-id-db db)
(define (db:initialize-run-id-db db update-only)
(handle-exceptions
exn
(begin
(release-dot-lock dbpath)
(if (> attemptnum 2)
(debug:print 0 "ERROR: tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath)
(db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1))))
(db:initialize-run-id-db db)
(sqlite3:with-transaction
db
(lambda ()
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests
(id INTEGER PRIMARY KEY,
run_id INTEGER DEFAULT -1,
testname TEXT DEFAULT 'noname',
|
| ︙ | | |
864
865
866
867
868
869
870
871
872
873
874
875
876
877
|
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
|
+
+
+
+
+
+
+
+
+
+
|
id INTEGER PRIMARY KEY,
test_id INTEGER,
update_time TIMESTAMP,
cpuload INTEGER DEFAULT -1,
diskfree INTEGER DEFAULT -1,
diskusage INTGER DEFAULT -1,
run_duration INTEGER DEFAULT 0);")))
(sqlite3:execute
db
"INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','
(* run-id 30000) ;; allow for up to 30k tests per run
run-id)
;; do a dummy query to test that the table exists and the db is truly readable
(sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000))
)))) ;; add strings db to rundb, not in use yet
db)
;;======================================================================
;; L O G G I N G D B
;;======================================================================
(define (open-logging-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
|
| ︙ | | |