433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
|
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
|
-
+
|
'("fieldname" #f)
'("fieldtype" #f))
(list "metadat" '("var" #f) '("val" #f))
(append (list "runs"
'("id" #f))
(map (lambda (k)(list k #f))
(append keys
(list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count"))))
(list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour"))))
(list "test_meta"
'("id" #f)
'("testname" #f)
'("owner" #f)
'("description" #f)
'("reviewed" #f)
'("iterated" #f)
|
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
|
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
|
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
|
)
'("tests" "test_steps" "test_data")))
(define (db:patch-schema-maindb maindb)
;;
;; remove all these some time after september 2016 (added in v1.6031
;;
(for-each
(lambda (column type default)
(handle-exceptions
exn
(if (string-match ".*duplicate.*" ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "Column last_update already added to runs table")
(db:general-sqlite-error-dump exn "alter table runs ..." #f "none"))
(sqlite3:execute
maindb
"ALTER TABLE runs ADD COLUMN last_update INTEGER DEFAULT 0"))
(handle-exceptions
exn
(if (string-match ".*duplicate.*" ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "Column " column " already added to runs table")
(db:general-sqlite-error-dump exn "alter table runs ..." #f "none"))
(sqlite3:execute
maindb
(conc "ALTER TABLE runs ADD COLUMN " column " " type " DEFAULT " default))))
(list "last_update" "contour")
(list "INTEGER" "TEXT" )
(list "0" "''" ))
;; these schema changes don't need exception handling
(sqlite3:execute
maindb
"CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs
FOR EACH ROW
BEGIN
UPDATE runs SET last_update=(strftime('%s','now'))
|
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
|
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
|
-
+
|
;;
(if (member 'new2old options)
(set! data-synced
(+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb)
data-synced)))
(if (member 'fixschema options)
(if (member 'schema options)
(begin
(db:patch-schema-maindb (db:dbdat-get-db mtdb))
(db:patch-schema-maindb (db:dbdat-get-db tmpdb))
(db:patch-schema-maindb (db:dbdat-get-db refndb))
(db:patch-schema-rundb (db:dbdat-get-db mtdb))
(db:patch-schema-rundb (db:dbdat-get-db tmpdb))
(db:patch-schema-rundb (db:dbdat-get-db refndb))))
|
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
|
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
|
+
|
(for-each (lambda (key)
(sqlite3:execute db "INSERT OR REPLACE INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT"))
keys)
(sqlite3:execute db (conc
"CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, \n "
fieldstr (if havekeys "," "") "
runname TEXT DEFAULT 'norun',
contour TEXT DEFAULT '',
state TEXT DEFAULT '',
status TEXT DEFAULT '',
owner TEXT DEFAULT '',
event_time TIMESTAMP DEFAULT (strftime('%s','now')),
comment TEXT DEFAULT '',
fail_count INTEGER DEFAULT 0,
pass_count INTEGER DEFAULT 0,
|
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
|
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
|
-
+
-
+
+
-
+
-
+
|
patts))
comparator)))
;; register a test run with the db, this accesses the main.db and does NOT
;; use server api
;;
(define (db:register-run dbstruct keyvals runname state status user)
(define (db:register-run dbstruct keyvals runname state status user contour-in)
(let* ((keys (map car keyvals))
(keystr (keys->keystr keys))
(keystr (keys->keystr keys))
(contour (or contour-in "")) ;; empty string to force no hierarcy and be backwards compatible.
(comma (if (> (length keys) 0) "," ""))
(andstr (if (> (length keys) 0) " AND " ""))
(valslots (keys->valslots keys)) ;; ?,?,? ...
(allvals (append (list runname state status user) (map cadr keyvals)))
(allvals (append (list runname state status user contour) (map cadr keyvals)))
(qryvals (append (list runname) (map cadr keyvals)))
(key=?str (string-intersperse (map (lambda (k)(conc k "=?")) keys) " AND ")))
(debug:print 3 *default-log-port* "keys: " keys " allvals: " allvals " keyvals: " keyvals " key=?str is " key=?str)
(debug:print 2 *default-log-port* "NOTE: using target " (string-intersperse (map cadr keyvals) "/") " for this run")
(if (and runname (null? (filter (lambda (x)(not x)) keyvals))) ;; there must be a better way to "apply and"
(db:with-db
dbstruct #f #f
(lambda (db)
(let ((res #f))
(apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time" comma keystr ") VALUES (?,?,?,?,strftime('%s','now')" comma valslots ");")
(apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time,contour" comma keystr ") VALUES (?,?,?,?,strftime('%s','now'),?" comma valslots ");")
allvals)
(apply sqlite3:for-each-row
(lambda (id)
(set! res id))
db
(let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
qry)
|