Megatest

Diff
Login

Differences From Artifact [da4e664704]:

To Artifact [52edf8a8de]:


11
12
13
14
15
16
17


18
19
20
21
22
23
24
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26







+
+







;; (include "megatest-version.scm")

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 readline apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
     http-client srfi-18 extras format) ;;  zmq extras)
(include "/nfs/site/disks/icf_fdk_cw_gwa002/srehman/fossil/dbi/dbi.scm")
(import (prefix dbi dbi:))

;; Added for csv stuff - will be removed
;;
(use sparse-vectors)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
624
625
626
627
628
629
630
631
632


633
634
635
636

637
638
639

640
641
642
643
644
645
646
626
627
628
629
630
631
632


633
634
635
636
637

638
639
640

641
642
643
644
645
646
647
648







-
-
+
+



-
+


-
+







				  (loop (+ row 1) 0 '() (append result (list curr-row))))
				 (else
				  (loop row (+ col 1) (append curr-row (list val)) result)))))))))
		    (hash-table-keys results))))
		((sqlite3)
		 (let* ((db-file   (or out-file (pathname-file input-db)))
			(db-exists (file-exists? db-file))
			(db        (sqlite3:open-database db-file)))
		   (if (not db-exists)(sqlite3:execute db "CREATE TABLE data (sheet,section,var,val);"))
			(db        (dbi:open 'sqlite3 (cons (cons ('dbname db-file) '())))))
		   (if (not db-exists)(dbi:exec db "CREATE TABLE data (sheet,section,var,val);"))
		   (configf:map-all-hier-alist
		    data
		    (lambda (sheetname sectionname varname val)
		      (sqlite3:execute db
		      (dbi:exec db
				       "INSERT OR REPLACE INTO data (sheet,section,var,val) VALUES (?,?,?,?);"
				       sheetname sectionname varname val)))
		   (sqlite3:finalize! db)))
		   (dbi:close db)))
		(else
		 (pp data))))))
      (if out-file (close-output-port out-port))
      (exit) ;; yes, bending the rules here - need to exit since this is a utility
      ))

(if (args:get-arg "-ping")