Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -31,12 +31,11 @@ SRCFILES = launch.scm runconfig.scm \ server.scm configf.scm keys.scm \ process.scm runs.scm \ tdb.scm mt.scm \ ezsteps.scm api.scm \ - subrun.scm archive.scm env.scm \ - diff-report.scm + subrun.scm archive.scm env.scm # cgisetup/models/pgdb.scm # module source files MSRCFILES = dbfile.scm debugprint.scm mtargs.scm commonmod.scm dbmod.scm \ @@ -43,11 +42,12 @@ tcp-transportmod.scm rmtmod.scm portlogger.scm apimod.scm \ configfmod.scm processmod.scm servermod.scm megatestmod.scm \ stml2.scm fsmod.scm cpumod.scm mtmod.scm odsmod.scm \ pkts.scm testsmod.scm pgdb.scm cookie.scm launchmod.scm \ subrunmod.scm runsmod.scm tasksmod.scm archivemod.scm \ - ezstepsmod.scm mtbody.scm envmod.scm genexample.scm mutils.scm + ezstepsmod.scm mtbody.scm envmod.scm genexample.scm mutils.scm \ + diff-report.scm transport-mode.scm : transport-mode.scm.template cp transport-mode.scm.template transport-mode.scm dashboard-transport-mode.scm : dashboard-transport-mode.scm.template @@ -56,11 +56,11 @@ mtest : transport-mode.scm dboard : dashboard-transport-mode.scm # dbmod.import.o is just a hack here -mofiles/mtbody.o : mofiles/launchmod.o readline-fix.scm mofiles/envmod.o mofiles/genexample.o mofiles/mutils.o +mofiles/mtbody.o : mofiles/launchmod.o readline-fix.scm mofiles/envmod.o mofiles/genexample.o mofiles/mutils.o mofiles/diff-report.o process.o : mofiles/processmod.o mofiles/configfmod.o : mofiles/processmod.o mofiles/processmod.o : mofiles/commonmod.o mofiles/servermod.o : mofiles/commonmod.o mofiles/rmtmod.o : mofiles/mtmod.o mofiles/apimod.o Index: diff-report.scm ================================================================== --- diff-report.scm +++ diff-report.scm @@ -19,13 +19,28 @@ (declare (unit diff-report)) ;; (declare (uses common)) (declare (uses debugprint)) (declare (uses rmtmod)) (declare (uses commonmod)) -(import commonmod +(declare (uses stml2)) + +(module diff-report + * +(import scheme + chicken + posix + debugprint + ports + srfi-1 + srfi-13 + srfi-69 + data-structures + + stml2 + commonmod rmtmod - debugprint) + ) ;; (include "common_records.scm") (use matchable) (use fmt) (use ducttape-lib) @@ -414,5 +429,6 @@ #f) (else (diff:deliver-diff-report src-run-id dest-run-id email-recipients-list: to-list html-output-file: html-file))))) +) Index: mtbody.scm ================================================================== --- mtbody.scm +++ mtbody.scm @@ -35,12 +35,13 @@ (declare (uses rmtmod)) (declare (uses archivemod)) (declare (uses mutils)) (declare (uses odsmod)) (declare (uses testsmod)) +(declare (uses diff-report)) -(use srfi-69) +(use srfi-69 readline) (module mtbody * (import scheme) @@ -60,10 +61,11 @@ md5 message-digest pathname-expand posix posix-extras + readline regex regex-case sparse-vectors srfi-1 srfi-18 @@ -144,10 +146,11 @@ apimod genexample mutils odsmod testsmod + diff-report ) (include "common_records.scm") (define *db* #f) ;; this is only for the repl, do not use in general!!!! @@ -2691,11 +2694,11 @@ (if *use-new-readline* (begin (install-history-file (get-environment-variable "HOME") ".megatest_history") ;; [homedir] [filename] [nlines]) (current-input-port (make-readline-port "megatest> "))) - (begin + #;(begin (gnu-history-install-file-manager (string-append (or (get-environment-variable "HOME") ".") "/.megatest_history")) (current-input-port (make-gnu-readline-port "megatest> ")))) (if (args:get-arg "-repl") @@ -2819,11 +2822,11 @@ ;; (sync-timeout (args:get-arg-number "-timeout")) (sync-period-in (args:get-arg "-period")) (sync-timeout-in (args:get-arg "-timeout")) (sync-period (if sync-period-in (string->number sync-period-in) #f)) (sync-timeout (if sync-timeout-in (string->number sync-timeout-in) #f)) - (lockfile (conc dest-db".sync-lock")) + (synclock-file (conc dest-db".sync-lock")) (keys (db:get-keys #f)) (thesync (lambda (last-update) (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...") (debug:print-info 0 *default-log-port* "PID = " (current-process-id)) (if (not (file-exists? dest-db)) @@ -2835,49 +2838,49 @@ (if res (debug:print-info 2 *default-log-port* "Synced " res " records from "src-db" to "dest-db) (debug:print-info 0 *default-log-port* "No sync due to permissions or other issue.")) res)))) (start-time (current-seconds)) - (synclock-mod-time (if (file-exists? lockfile) + (synclock-mod-time (if (file-exists? synclock-file) (handle-exceptions exn #f (file-modification-time synclock-file)) #f)) (age (if synclock-mod-time (- (current-seconds) synclock-mod-time) 1000)) ) (if (and src-db dest-db) (if (file-exists? src-db) - (if (and (file-exists? lockfile) (< age 20)) - (debug:print 0 *default-log-port* "Lock "lockfile" exists, skipping sync...") + (if (and (file-exists? synclock-file) (< age 20)) + (debug:print 0 *default-log-port* "Lock "synclock-file" exists, skipping sync...") (begin - (if (file-exists? lockfile) + (if (file-exists? synclock-file) (begin - (debug:print 0 *default-log-port* "Deleting old lock file " lockfile) - (delete-file lockfile) + (debug:print 0 *default-log-port* "Deleting old lock file " synclock-file) + (delete-file synclock-file) ) ) (dbfile:with-simple-file-lock - lockfile + synclock-file (lambda () (let loop ((last-changed (current-seconds)) (last-update 0)) (let* ((changes (handle-exceptions exn (begin (debug:print 0 *default-log-port* "Exception in sync: "(condition->list exn)) - (delete-file lockfile) + (delete-file synclock-file) (exit)) (thesync last-update))) (now-time (current-seconds))) (if (and sync-period sync-timeout) ;; (if (and (< (- now-time start-time) 600) ;; hard limit on how long we run for (> sync-timeout (- now-time last-changed))) (begin (if sync-period (thread-sleep! sync-period)) (loop (if (> changes 0) now-time last-changed) now-time)))))))) - (debug:print 0 *default-log-port* "Releasing lock file " lockfile) + (debug:print 0 *default-log-port* "Releasing lock file " synclock-file) ) ) (debug:print 0 *default-log-port* "No sync due to unreadble or non-existant source file"src-db)) (debug:print 0 *default-log-port* "Usage for -db2db; -to and -from must be specified")) (set! *didsomething* #t)))