Megatest

(module dbmod
	*
	
(import scheme
	chicken
	data-structures
	extras
	files

	(prefix sqlite3 sqlite3:)
	posix
	typed-records
	srfi-1
	srfi-18
	srfi-69

;;        (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)
  (assert (sqlite3:database? inmem) "FATAL: sync-gasket: inmem is not a db")
  (assert (sqlite3:database? dbh) "FATAL: sync-gasket: dbh is not a db")
  (case (dbfile:sync-method)
    ((none) #f)
    ((attach)
     (dbmod:attach-sync tables inmem dbfname direction))
    ((newsync)
     (dbmod:new-sync tables inmem dbh dbfname direction))
    (else

			(or newstate  currstate "NOT_STARTED")
			(or newstatus currstate "UNKNOWN")
			run-id testname)))))
;;======================================================================
;; db to db sync
;;======================================================================

(define (dbmod:db-to-db-sync src-db dest-db last-update init-proc keys)
  (if (and (file-exists? src-db)
	   (file-read-access? src-db))
      (let* ((d-wr   (or (and (file-exists? dest-db)
			      (file-write-access? dest-db)) ;; exists and writable
			 (let* ((dirname (pathname-directory dest-db)))
			   (and 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))))



)

  -list-run-time          : list time requered to complete runs. It supports following switches
                            -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
  -list-test-time	  : list time requered to complete each test in a run. It following following arguments
                            -runname <patt> -target <patt> -dumpmode <csv,json,plain-text>
  -syscheck               : do some very basic checks; write access and space in tmp, home, runs, links and 
                            is $DISPLAY valid 
  -list-waivers           : dump waivers for specified target, runname, testpatt to stdout
  -db2db                  : sync db to db, use -from and -to to specify the databases

Diff report
  -diff-rep               : generate diff report (must include -src-target, -src-runname, -target, -runname
                                                  and either -diff-email or -diff-html)
  -src-target <target>
  -src-runname <target>
  -diff-email <emails>    : comma separated list of email addresses to send diff report

			"-runstep"
			"-logpro"
			"-m"
			"-rerun"

			"-days"
			"-rename-run"
			"-from"
			"-to"
			"-dest"
                        "-source" 
                        "-time-stamp" 
			;; values and messages
			":category"
			":variable"

			"-clean-cache"
			"-no-cache"
			"-cache-db"
			"-cp-eventtime-to-publishtime"
                        "-use-db-cache"
                        "-prepend-contour"


			;; misc
			"-repl"
			"-lock"
			"-unlock"
			"-list-servers"
			"-kill-servers"
                        "-run-wait"      ;; wait on a run to complete (i.e. no RUNNING)

			"-create-megatest-area"
			"-mark-incompletes"

			"-convert-to-norm"
			"-convert-to-old"
			"-import-megatest.db"
			"-sync-to-megatest.db"
			"-db2db"
                        "-sync-brute-force"
			"-logging"
			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only

                        "-diff-rep"

      (set! *didsomething* #t)))

(if (args:get-arg "-sync-to")
    (let ((toppath (launch:setup)))
      (tasks:sync-to-postgres *configdat* (args:get-arg "-sync-to"))
      (set! *didsomething* #t)))

;; use with -from and -to
;;
(if (args:get-arg "-db2db")
    (let* ((duh      (launch:setup))
	   (src-db   (args:get-arg "-from"))
	   (dest-db  (args:get-arg "-to"))
	   (lockfile (conc dest-db".lock"))
	   ;; (locked   (common:simple-file-lock lockfile))
	   (keys     (db:get-keys #f))
	   (res      ;; (if locked
			 (dbmod:db-to-db-sync src-db dest-db 0 (dbfile:db-init-proc) keys)
			 ;;	 #f)))
			 ))
      
      (if (and src-db dest-db)
	  (begin
	    (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...")
	    (if res
		(begin
		  (common:simple-file-release-lock lockfile)
		  (debug:print 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db))
		(debug:print 0 *default-log-port* "Skipping sync, there is a sync in progress."))
	    (set! *didsomething* #t))
	  (debug:print 0 *default-log-port* "Usage for -db2db; -to and -from must be specified"))))

(if (args:get-arg "-list-test-time")
     (let* ((toppath (launch:setup))) 
     (task:get-test-times)  
     (set! *didsomething* #t)))

(if (args:get-arg "-list-run-time")
     (let* ((toppath (launch:setup)))