Megatest

# ARCHSTR=$(BASH_MACHTYPE)_$(shell lsb_release -sr)
ARCHSTR=$(shell if [[ -e /usr/bin/sw_vers ]]; then /usr/bin/sw_vers -productVersion; else lsb_release -sr; fi)
# ARCHSTR=$(shell bash -c "echo \$$MACHTYPE")

PNGFILES = $(shell cd docs/manual;ls *png)


mtest: $(OFILES) readline-fix.scm $(MOFILES) $(MOIMPFILES) megatest.o  megatest-version.scm transport-mode.scm
	csc $(CSCOPTS) $(OFILES) $(MOFILES) $(MOIMPFILES) megatest.o -o mtest

showmtesthash:
	@echo $(MTESTHASH)

dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) megatest-version.scm megatest-fossil-hash.scm
	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) -o dboard

					 dbfullname syncdir)
					 (system (conc "megatest -db2db -from "tmpdb" -to "dbfname"&"))
					 (mutex-unlock! *db-with-db-mutex*)
					 (thread-sleep! 0.5) ;; ensure at least 1/2 second down time between sync calls
					 (set! *sync-in-progress* #f)))))
    ;; (dbmod:sync-tables tables #f db inmem)
    ;; (if db
    (dbmod:sync-gasket tables #f inmem db dbfullname 'fromdest keys) ;; ) ;; load into inmem
    (dbr:dbstruct-last-update-set! dbstruct (current-seconds)) ;; should this be offset back in time by one second?
    dbstruct))

;;    (if (eq? syncdir 'todisk) ;; sync to disk normally, sync from in dashboard
;;        (dbmod:sync-tables tables last-update inmem db)
;;        (dbmod:sync-tables tables last-update db inmem))))

;; direction: 'fromdest 'todest
;;
(define (dbmod:sync-gasket tables last-update inmem dbh dbfname direction keys)
  (assert (sqlite3:database? inmem) "FATAL: sync-gasket: inmem is not a db")
  (assert (sqlite3:database? dbh) "FATAL: sync-gasket: dbh is not a db")
  (debug:print-info 0 *default-log-port* "Db sync using "(dbfile:sync-method)" method")
  (case (dbfile:sync-method)
    ((none) #f)
    ((attach)
     (dbmod:attach-sync tables inmem dbfname direction))
    ((newsync) ;; DON'T USE THIS ONE. IT IS BORKED
     (dbmod:new-sync tables inmem dbh dbfname direction))
    (else
     (case direction
       ((todisk)
	(dbmod:sync-tables tables last-update keys inmem dbh)
	)
       (else
	(dbmod:sync-tables tables last-update keys dbh inmem))))))

(define (dbmod:close-db dbstruct)
  ;; do final sync to disk file
  ;; (do-sync ...)
  (sqlite3:finalize! (dbr:dbstruct-ondiskdb dbstruct)))

;;======================================================================

;;
;; if last-update specified ("field-name" . time-in-seconds)
;;    then sync only records where field-name >= time-in-seconds
;;    IFF field-name exists
;;
;; Use (db:sync-all-tables-list keys) to get the tbls input
;;
(define (dbmod:sync-tables tbls last-update keys fromdb todb)
  (assert (sqlite3:database? fromdb) "FATAL: dbmod:sync-tables called with fromdb not a database" fromdb)
  (assert (sqlite3:database? todb) "FATAL: dbmod:sync-tables called with fromdb not a database" todb)
  (let ((specials    `(("keys" "fieldname")
		       ("metadat" "var")
		       ,(cons "runs" (cons "runname" keys))
		       ("tests" "run_id" "testname" "item_path")
		       ("test_meta" "testname")
		       ("test_steps" "test_id" "stepname" "state")
		       ("test_data" "test_id" "category" "variable")))
	(stmts       (make-hash-table)) ;; table-field => stmt
	(all-stmts   '())              ;; ( ( stmt1 value1 ) ( stml2 value2 ))
	(numrecs     (make-hash-table))
	(start-time  (current-milliseconds))
	(tot-count   0))
    (for-each ;; table
     (lambda (tabledat)
       (let* ((count (match tabledat
		       ((tablename . fields)
			(debug:print-info 0 *default-log-port* "Syncing table "tablename)
			(dbmod:sync-table tablename fields fromdb todb specials))
		       (else
			(debug:print-warn 0 *default-log-port* "Bad tabledat entry: "tabledat)
			0))))
	 (set! tot-count (+ tot-count count))))
     tbls)
    (debug:print-info 0 *default-log-port* "dbmod:sync-tables completed in "(- (current-milliseconds) start-time)"ms")
    tot-count))

(define (dbmod:sync-table tablename fields from-db to-db specials)
  (let* ((key-fields       (alist-ref tablename specials equal?))
	 (field-names      (map car fields))
	 (has-last-update  (member "last_update" field-names))
	 (fields-sans-lu   (filter (lambda (x)
				     (not (member x '("id" "last_update"))))
				   field-names))
	 (get-vals        (lambda (db id fields)
			    (debug:print-info 0 *default-log-port* "get-vals: fields="fields", id="id)
			    (let* ((qry (conc "SELECT "(string-intersperse fields ",")" FROM "tablename" WHERE id=?;"))
				   (res #f))
			      (sqlite3:for-each-row
			       (lambda tuple
				 (set! res tuple))
			       db qry id)
			      res)))
	 (clean-up-qry    (lambda (from-id)
			    (debug:print-info 0 *default-log-port* "key-fields="key-fields", from-id="from-id)
			    (let* ((vals (get-vals from-db from-id key-fields))
				   (qry  (conc "DELETE FROM "tablename" WHERE "(string-intersperse key-fields "=? AND ")"=?;")))
			      (debug:print-info 0 *default-log-port* "qry: "qry", vals="vals)
			      (apply sqlite3:execute to-db qry vals))))
	 (get-ids          (lambda (db)
			     (sqlite3:fold-row (lambda (res id)
						 (cons id res))
					       '()
					       db
					       (conc "SELECT id FROM "tablename";"))))
	 (get-val          (lambda (db fieldname id)

	 (ins-row         (lambda (db id row)
			    (let* ((qry (conc "INSERT INTO "tablename" (id,"
					      (string-intersperse fields-sans-lu ",")
					      ") VALUES ("id","
					      (string-intersperse
					       (make-list (length fields-sans-lu) "?")
					       ",")
					      ");"))
				   (proc (lambda ()
					   (apply sqlite3:execute db qry row))))
			      ;; (debug:print-info 0 *default-log-port* "qry="qry)
			      (handle-exceptions ;; on exception do the cleanup qry then try one more time
				  exn
				(begin
				  (clean-up-qry id)
				  (proc))
				(proc)))))
			      
	 (num-inserts     0)
	 (num-updates     0)
	 )
    ;; (debug:print-info 0 *default-log-port* "field-names: "field-names", fields-sans-lu: "fields-sans-lu)
    (sqlite3:with-transaction
     from-db
     (lambda ()
       (let* ((from-ids (get-ids from-db)))
	 ;; (debug:print-info 0 *default-log-port* "Table "tablename", has "(length from-ids)" records.")
 	 (sqlite3:with-transaction
 	  to-db
	  (lambda ()
	    (let* ((to-ids (get-ids to-db)))
	      ;; (debug:print 0 *default-log-port* "to-ids="to-ids)
	      (for-each ;; from-id
	       (lambda (from-id)
		 (if (member from-id to-ids)
		     (for-each ;; case where record exists, do one by one the fields if different
		      (lambda (fieldname)
			(let* ((from-val (get-val from-db fieldname from-id))
			       (dest-val (get-val to-db   fieldname from-id)))
			  #;(debug:print 0 *default-log-port*
				       "fieldname="fieldname
				       ", from-id="from-id
				       ", from-val="from-val
				       ", dest-val="dest-val
				       )
			  (if (not (equal? from-val dest-val))
			      (let* ((qry-proc (lambda ()
						 (sqlite3:execute to-db (conc "UPDATE "tablename" SET "fieldname"=? WHERE id=?;")
								  from-val from-id))))
				(handle-exceptions ;; try to remove the offending record and re-try once the update
				    exn
				  (begin
				    (clean-up-qry from-id)
				    (qry-proc))
				  (qry-proc))
				(set! num-updates (+ num-updates 1))))))
		      fields-sans-lu)
		     (let ((row (get-row from-db from-id))) ;; need to insert the row
		       ;; (debug:print 0 *default-log-port* "row="row)
		       (set! num-inserts (+ num-inserts 1))
		       (ins-row to-db from-id row))))
	       from-ids)))))))
    (+ num-inserts num-updates)))

;;     (for-each ;; table
;;      (lambda (tabledat)
;;        (let* ((tablename        (car tabledat))
;; 	      (fields           (cdr tabledat))
;; 	      (has-last-update  (member "last_update" fields))

					     ".")))
			   (if dirname
			       (file-exists? dirname)
			       (file-write-access? dirname)))))
	     (tables (db:sync-all-tables-list keys))
	     (sdb    (dbmod:safely-open-db src-db init-proc #t))
	     (ddb    (dbmod:safely-open-db dest-db init-proc d-wr)))
	(dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys))))

)