Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -69,11 +69,11 @@ ((general-call) (let ((stmtname (car params)) (realparams (cdr params))) (db:general-call db stmtname realparams))) ((sync-inmem->db) (db:sync-back)) ((kill-server) - (db:sync-to *inmemdb* *db*) + (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*) ;; (db:sync-to *inmemdb* *db*) (let ((hostname (car *runremote*)) (port (cadr *runremote*)) (pid (if (null? params) #f (car params))) (th1 (make-thread (lambda ()(thread-sleep! 3)(debug:print 0 "Server exiting!")(exit 0)) "Server exit thread"))) (debug:print 0 "WARNING: Server on " hostname ":" port " going down by user request!") Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -14,11 +14,11 @@ ;;====================================================================== (require-extension (srfi 18) extras tcp) ;; rpc) ;; (import (prefix rpc rpc:)) -(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64) +(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format) (import (prefix sqlite3 sqlite3:)) (import (prefix base64 base64:)) ;; Note, try to remove this dependency ;; (use zmq) @@ -109,21 +109,69 @@ ;; (define (db:sync-table tblname fields fromdb todb) (define (db:tbls db) (let ((keys (db:get-keys db))) (list + (list "keys" + '("id" #f) + '("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")))) + (list "tests" + '("id" #f) + '("run_id" #f) + '("testname" #f) + '("host" #f) + '("cpuload" #f) + '("diskfree" #f) + '("uname" #f) + '("rundir" #f) + '("shortdir" #f) + '("item_path" #f) + '("state" #f) + '("status" #f) + '("attemptnum" #f) + '("final_logf" #f) + '("logdat" #f) + '("run_duration" #f) + '("comment" #f) + '("event_time" #f) + '("fail_count" #f) + '("pass_count" #f) + '("archived" #f)) + (list "test_steps" + '("id" #f) + '("test_id" #f) + '("stepname" #f) + '("state" #f) + '("status" #f) + '("event_time" #f) + '("comment" #f) + '("logfile" #f)) + (list "test_meta" + '("id" #f) + '("testname" #f) + '("owner" #f) + '("description" #f) + '("reviewed" #f) + '("iterated" #f) + '("avg_runtime" #f) + '("avg_disk" #f) + '("tags" #f) + '("jobgroup" #f))))) + ;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) ) (define (db:sync-tables tbls fromdb todb) - (let ((stmts (make-hash-table)) ;; table-field => stmt - (all-stmts '())) ;; ( ( stmt1 value1 ) ( stml2 value2 )) + (let ((stmts (make-hash-table)) ;; table-field => stmt + (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) + (numrecs (make-hash-table)) + (start-time (current-milliseconds))) (for-each ;; table (lambda (tabledat) (let* ((tablename (car tabledat)) (fields (cdr tabledat)) (num-fields (length fields)) @@ -164,23 +212,35 @@ todb (lambda () (for-each ;; (lambda (fromrow) (let* ((a (vector-ref fromrow 0)) - (curr (hash-table-ref todat a)) + (curr (hash-table-ref/default todat a #f)) (same #t)) (let loop ((i 0)) - (if (not (equal? (vector-ref fromrow i)(vector-ref curr i))) + (if (or (not curr) + (not (equal? (vector-ref fromrow i)(vector-ref curr i)))) (set! same #f)) (if (and same (< i (- num-fields 1))) (loop (+ i 1)))) - (if (not same)(apply sqlite3:execute full-ins (vector->list fromrow))))) + (if (not same) + (begin + (apply sqlite3:execute stmth (vector->list fromrow)) + (hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0))))))) fromdat))) (sqlite3:finalize! stmth)))) - tbls))) - + tbls) + (let ((runtime (- (current-milliseconds) start-time))) + (debug:print 0 "INFO: db sync, total run time " runtime " ms") + (for-each + (lambda (dat) + (let ((tblname (car dat)) + (count (cdr dat))) + (if (> count 0) + (debug:print 0 (format #f " ~10a ~5a" tblname count))))) + (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b)))))))) (define (db:sync-to fromdb todb) ;; strategy ;; 1. Get all run-ids ;; 2. For each run-id @@ -293,11 +353,11 @@ (if (> trecchgd 0) (debug:print 0 "synced " trecchgd " changed records in tests table")) (if (> tmrecchgd 0) (debug:print 0 "sync'd " tmrecchgd " changed records in test_meta table")) (+ rrecchgd trecchgd tmrecchgd))) (define (db:sync-back) - (db:sync-to *inmemdb* *db*)) + (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)) ;; (db:sync-to *inmemdb* *db*)) ;; keeping it around for debugging purposes only (define (open-run-close-no-exception-handling proc idb . params) (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params) (if (or *db-write-access* Index: http-transport.scm ================================================================== --- http-transport.scm +++ http-transport.scm @@ -426,11 +426,11 @@ (let loop ((count 0)) ;; Use this opportunity to sync the inmemdb to db (let ((start-time (current-milliseconds)) (sync-time #f) (rem-time #f)) - (if *inmemdb* (db:sync-to *inmemdb* *db*)) + (if *inmemdb* (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)) ;; (db:sync-to *inmemdb* *db*)) (set! sync-time (- (current-milliseconds) start-time)) (debug:print 0 "SYNC: time= " sync-time) (set! rem-time (quotient (- 4000 sync-time) 1000)) (if (and (< rem-time 4) (> rem-time 0)) @@ -471,11 +471,11 @@ (loop 0)) (begin (debug:print-info 0 "Starting to shutdown the server.") ;; need to delete only *my* server entry (future use) (set! *time-to-exit* #t) - (if *inmemdb* (db:sync-to *inmemdb* *db*)) + (if *inmemdb* (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)) ;; (db:sync-to *inmemdb* *db*)) (open-run-close tasks:server-deregister-self tasks:open-db (get-host-name)) (thread-sleep! 1) (debug:print-info 0 "Max cached queries was " *max-cache-size*) (debug:print-info 0 "Number of cached writes " *number-of-writes*) (debug:print-info 0 "Average cached write time " @@ -518,11 +518,11 @@ (th3 (make-thread http-transport:keep-running "Keep running"))) ;; (th1 (make-thread server:write-queue-handler "write queue"))) (set! *cache-on* #t) (set! *db* (open-db)) (set! *inmemdb* (open-in-mem-db)) - (db:sync-to *db* *inmemdb*) + (db:sync-tables (db:tbls *db*) *db* *inmemdb*) ;; (db:sync-to *db* *inmemdb*) (thread-start! th2) (thread-start! th3) ;; (thread-start! th1) (set! *didsomething* #t)