Megatest

;; (include "call-with-environment-variables/call-with-environment-variables.scm")

(module mtserve
	*

  (import scheme

	  chicken.base
;;	  chicken.bitwise
;;	  chicken.condition
;;	  ;; chicken.csi
;;	  chicken.eval
;;	  chicken.file
;;	  chicken.file.posix
;;	  chicken.format
;;	  chicken.io
;;	  chicken.irregex
;;	  chicken.pathname
;;	  chicken.port
;;	  chicken.pretty-print
;;	  chicken.process
	  chicken.process-context
;;	  chicken.process-context.posix
;;	  chicken.process.signal
;;	  chicken.random
;;	  chicken.repl
;;	  chicken.sort
	  chicken.string
;;	  chicken.tcp
;;	  chicken.time
;;	  chicken.time.posix
;;	  
;;	  (prefix base64 base64:)
;;	  (prefix sqlite3 sqlite3:)
;;	  (prefix sxml-modifications sxml-)

;;	  system-information
;;	  typed-records
;;	  uri-common
;;	  z3
;;	  
;;	  srfi-1
;;	  srfi-4
	  srfi-18
;;	  srfi-13
;;	  srfi-98
;;	  srfi-69
;;
;;	  ;; local modules
;;	  autoload
;;	  adjutant
;;	  csv-xml
;;	  ;; hostinfo
;;	  mtver
;;	  mutils
;;	  cookie
;;	  csv-xml
;;	  ducttape-lib
	  (prefix mtargs args:)
;;	  pkts
;;	  stml2
;;	  (prefix dbi dbi:)
;;
;;	  apimod
;;	  archivemod
;;	  bigmod
	  commonmod
;;	  configfmod
;;	  dbmod
	  debugprint
;;	  ezstepsmod
	  launchmod
;;	  processmod
;;	  rmtmod
;;	  runsmod
;;	  servermod
;;	  tasksmod
;;	  testsmod
	  dbmgrmod
;;	  
;;	  ulex
	  )

;;   ;; ulex parameters
;;   (work-method 'direct)
;;   (return-method 'direct)

;; (include "tests.scm")
;; (include "genexample.scm")
;; (include "tdb.scm")
;; (include "env.scm")
;; (include "diff-report.scm")
;; (include "ods.scm")
;; 

  ;; process args
  (define remargs (args:get-args 
      		   (argv)
      		   (list  ;; "-runtests"  ;; run a specific test
      			  ;; "-config"    ;; override the config file name
      			  ;; "-append-config"
      			  ;; "-execute"   ;; run the command encoded in the base64 parameter
      			  ;; "-step"
      			  ;; "-target"
      			  ;; "-reqtarg"
      			  ;; ":runname"
      			  ;; "-runname"
      			  ;; ":state"  
      			  ;; "-state"
      			  ;; ":status"
      			  ;; "-status"
      			  ;; "-list-runs"
 			  ;; "-testdata-csv"
      			  ;; "-testpatt"
 			  ;; "--modepatt"
 			  ;; "-modepatt"
 			  ;; "-tagexpr"
      			  ;; "-itempatt"
      			  ;; "-setlog"
      			  ;; "-set-toplog"
      			  ;; "-runstep"
      			  ;; "-logpro"
      			  ;; "-m"
      			  ;; "-rerun"
			  ;; 
      			  ;; "-days"
      			  ;; "-rename-run"
      			  ;; "-to"
      			  ;; "-dest"
 			  ;; "-source" 
 			  ;; "-time-stamp" 
      			  ;; ;; values and messages
      			  ;; ":category"
      			  ;; ":variable"
      			  ;; ":value"
      			  ;; ":expected"
      			  ;; ":tol"
      			  ;; ":units"
			  ;; 
      			  ;; ;; misc
      			  ;; "-start-dir"
 			  ;; "-run-patt"
 			  ;; "-target-patt"   
      			  ;; "-contour"
 			  ;; "-area-tag"  
 			  ;; "-area"  
      			  ;; "-run-tag"
      			  "-server"
 			  "-db"            ;; file name for setting up a server
      			  ;; "-adjutant"
      			  ;; "-transport"
      			  ;; "-port"
      			  ;; "-extract-ods"
      			  ;; "-pathmod"
      			  ;; "-env2file"
      			  ;; "-envcap"
      			  ;; "-envdelta"
      			  ;; "-setvars"
      			  ;; "-set-state-status"
 			  ;; 
 			  ;; ;; move runs stuff here
 			  ;; "-remove-keep"           
      			  ;; "-set-run-status"
      			  ;; "-age"
			  ;; 
      			  ;; ;; archive 
      			  ;; "-archive"
      			  ;; "-actions"
      			  ;; "-precmd"
      			  ;; "-include"
      			  ;; "-exclude-rx"
      			  ;; "-exclude-rx-from"
      			  ;; 
      			  "-debug" ;; for *verbosity* > 2
      			  ;; "-debug-noprop"
      			  ;; "-create-test"
      			  ;; "-override-timeout"
      			  ;; "-test-files"  ;; -test-paths is for listing all
      			  ;; "-load"        ;; load and exectute a scheme file
      			  ;; "-section"
      			  ;; "-var"
      			  ;; "-dumpmode"
      			  ;; "-run-id"
      			  ;; "-ping"
      			  ;; "-refdb2dat"
      			  ;; "-o"
      			  ;; "-log"
 			  ;; "-autolog"
 			  ;; "-sync-log"
      			  ;; "-since"
      			  ;; "-fields"
      			  ;; "-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state
      			  ;; "-sort"
      			  ;; "-target-db"
      			  ;; "-source-db"
      			  ;; "-prefix-target"
			  ;; 
 			  ;; "-src-target"
 			  ;; "-src-runname"
 			  ;; "-diff-email"
      			  ;; "-sync-to"			
      			  ;; "-pgsync"
      			  ;; "-kill-wait"    ;; wait this long before removing test (default is 10 sec)
 			  ;; "-diff-html"
			  ;; 
      			  ;; ;; wizards, area capture, setup new ...
      			  ;; "-extract-skeleton"
      			  )
       		   (list  "-h" "-help" "--help"
      			  ;; "-manual"
      			  "-version"
      		          ;; "-force"
      		          ;; "-xterm"
      		          ;; "-showkeys"
      		          ;; "-show-keys"
      		          ;; "-test-status"
      			  ;; "-set-values"
      			  ;; "-load-test-data"
      			  ;; "-summarize-items"
      		          ;; "-gui"
      			  ;; "-daemonize"
      			  ;; "-preclean"
      			  ;; "-rerun-clean"
      			  ;; "-rerun-all"
      			  ;; "-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)
      			  ;; "-one-pass"      ;;
      			  ;; "-local"         ;; run some commands using local db access
      			  ;; "-generate-html"
      			  ;; "-generate-html-structure" 
      			  ;; "-list-run-time"
                          ;; "-list-test-time"
      			  ;; 
      			  ;; ;; misc queries
      			  ;; "-list-disks"
      			  ;; "-list-targets"
      			  ;; "-list-db-targets"
      			  ;; "-show-runconfig"
      			  ;; "-show-config"
      			  ;; "-show-cmdinfo"
      			  ;; "-get-run-status"
      			  ;; "-list-waivers"
			  ;; 
      			  ;; ;; queries
      			  ;; "-test-paths" ;; get path(s) to a test, ordered by youngest first
			  ;; 
      			  ;; "-runall"    ;; run all tests, respects -testpatt, defaults to %
      			  ;; "-run"       ;; alias for -runall
      			  ;; "-remove-runs"
                          ;; "-kill-runs"
                          ;; "-kill-rerun"
                          ;; "-keep-records" ;; use with -remove-runs to remove only the run data
      			  ;; "-rebuild-db"
      			  ;; "-cleanup-db"
      			  ;; "-rollup"
      			  ;; "-update-meta"
      			  ;; "-create-megatest-area"
      			  ;; "-mark-incompletes"
			  ;; 
      			  ;; "-convert-to-norm"
      			  ;; "-convert-to-old"
      			  ;; "-import-megatest.db"
      			  ;; "-sync-to-megatest.db"
 			  ;; "-sync-brute-force"
      			  ;; "-logging"
      			  ;; "-v" ;; verbose 2, more than normal (normal is 1)
      			  ;; "-q" ;; quiet 0, errors/warnings only
			  ;; 
                          ;; "-diff-rep"
			  ;; 
      			  ;; "-syscheck"
      			  ;; "-obfuscate"
      			  ;; junk placeholder
      			  ;; "-:p"
      			  
                          )
      		   args:arg-hash
      		   0))
  
  ;; Add args that use remargs here
  ;;
  (if (not (null? remargs))
      (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))
  
  ;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
  ;;
  (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtserverc")))
    (if (common:file-exists? debugcontrolf)
	(load debugcontrolf)))
  
  ;; before doing anything else change to the start-dir if provided
  ;;
  (if (args:get-arg "-start-dir")
      (if (common:file-exists? (args:get-arg "-start-dir"))
          (let ((fullpath (common:real-path (args:get-arg "-start-dir"))))
            (set-environment-variable! "PWD" fullpath)
            (change-directory fullpath))
      	  (begin
      	    (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
      	    (exit 1))))
  

  (define (main)
    (debug:setup)
    (make-and-init-bigdata) 
    (let ((tl        (launch:setup))
 	  (dbname    (args:get-arg "-db")))
      (if dbname
	  (rmt:server-launch dbname)
	  (debug:print 0 *default-log-port* "Usage: mtserve -db <dbpath/file>.db"))))
  #;(set! *didsomething* #t)
  
  
  (thread-join!
   (thread-start!
    (make-thread main)))

)

;; (define *usage-log-file* #f)    ;; put path to file for logging usage in this var in the ~/.megatestrc file
;; (define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file
;; 
;; ;;======================================================================