Megatest

File utils/mt-new-to-old.scm from the latest check-in

(module mt-new-to-old
 *

(import
 scheme
 chicken.file
 chicken.base
 chicken.string
 chicken.pretty-print
 sqlite3)

(if (not (file-exists? ".megatest/main.db"))
    (begin
     (print "No .megatest/main.db found, exiting")
     (exit 1)))

(copy-file ".megatest/main.db" "megatest.db" #t)


(define tests_fields "run_id,testname,host,cpuload,diskfree,uname,rundir,shortdir,item_path,state,status,attemptnum,final_logf,logdat,run_duration,comment,event_time,fail_count,pass_count,archived")

(define extra_fields "testname,item_path")

(define (import-one dbfile destdb)
  (print "Importing "dbfile)
  (let* ((db   (open-database dbfile))
	 (rows (fold-row
		(lambda (res . row)
		  (cons row res))
		'()
		db
		(conc "SELECT "extra_fields","tests_fields" FROM tests;"))))
    (finalize! db)
    (print "Found "(length rows)" records to insert.")
    (for-each
     (lambda (row)
       (let* ((testname (car row))
	      (itempath (cadr row))
	      (remrow   (cddr row))
	      (run-id   (car remrow))
	      (ready-row (string-intersperse
			  (map (lambda (x)
				 (if (number? x)
				     (conc x)
				     (conc "'"x"'")))
			       remrow)

			  ",")))
	 (print run-id","testname"/"itempath)
	 (execute destdb "DELETE FROM tests WHERE testname=? AND item_path=? AND run_id=?;"
		  (or testname "")
		  (or itempath "")
		  (or run-id ""))
	 (apply execute destdb (conc "INSERT INTO tests ("tests_fields") VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);") remrow)))
     ;; ("ready-row");"))))
     rows)))

(define (process-all)
  (let* ((outdb (open-database "megatest.db"))
	 (indbs (glob ".megatest/[0-9]*.db")))
    (with-transaction
     outdb
     (lambda ()
       (for-each
	(lambda (dbfname)
	  (import-one dbfname outdb))
	indbs)))
    (finalize! outdb)))

)

(import mt-new-to-old)
(process-all)