Megatest

# DOES NOT REBUILD DOCS
#
$(PREFIX)/share/docs/megatest_manual.html : docs/manual/megatest_manual.html
	mkdir -p $(PREFIX)/share/docs
	$(INSTALL) docs/manual/megatest_manual.html $(PREFIX)/share/docs/megatest_manual.html
	for png in $(PNGFILES);do $(INSTALL) docs/manual/$$png $(PREFIX)/share/docs/$$png;done

$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
	mkdir -p $(PREFIX)/share/db
	$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql

#multi-dboard : multi-dboard.scm $(OFILES) $(GOFILES)
#	csc $(CSCOPTS) $(OFILES) $(GOFILES) multi-dboard.scm -o multi-dboard

# 
# $(PREFIX)/bin/revtagfsl : utils/revtagfsl.scm
#	csc utils/revtagfsl.scm -o $(PREFIX)/bin/revtagfsl

	utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard
	$(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard

install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
          $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \
          $(PREFIX)/share/db/mt-pg.sql

$(PREFIX)/bin/.$(ARCHSTR) : 
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib

test: tests/tests.scm
	cd tests;csi -I .. -b -n tests.scm

	  (setenv "MT_RUN_AREA_HOME" *toppath*)
	  (setenv "MT_TESTSUITE_NAME" (common:get-testsuite-name)))
	(begin
	  (debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")
          ;;(exit 1)
          #f
          ))
    ;; if have -append-config then read and append here
    (let ((cfname (args:get-arg "-append-config")))
      (if (and cfname
	       (file-read-access? cfname))
	  (read-config cfname *configdat* #t))) ;; values are added to the hash, no need to do anything special.
    *toppath*))

(define (get-best-disk confdat testconfig)
  (let* ((disks   (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
		      (hash-table-ref/default confdat "disks" #f)))
	 (minspace (let ((m (configf:lookup confdat "setup" "minspace")))
		     (string->number (or m "10000")))))

  -stop-server id         : stop server specified by id (see output of -list-servers), use
                            0 to kill all
  -repl                   : start a repl (useful for extending megatest)
  -load file.scm          : load and run file.scm
  -mark-incompletes       : find and mark incomplete tests
  -ping run-id|host:port  : ping server, exit with 0 if found
  -debug N|N,M,O...       : enable debug 0-N or N and M and O ...
  -config fname           : override the megatest.config file with fname
  -append-config fname    : append fname to the megatest.config file

Utilities
  -env2file fname         : write the environment to fname.csh and fname.sh
  -envcap fname=context   : save current variables labeled as context in file fname
  -refdb2dat refdb        : convert refdb to sexp or to format specified by -dumpmode
                            formats: perl, ruby, sqlite3, csv (for csv the -o param
                            will substitute %s for the sheet name in generating 

# Get test path, use '.' to get a single path or a specific path/file pattern
megatest -test-files 'logs/*.log' -target ubuntu/n%/no% -runname w49% -testpatt test_mt%

Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))

;;  -gui                    : start a gui interface


;; 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"  

CREATE TABLE IF NOT EXISTS keys (
       id INTEGER PRIMARY KEY,
       fieldname TEXT,
       fieldtype TEXT,
       CONSTRAINT keyconstraint UNIQUE (fieldname));
		    
CREATE TABLE IF NOT EXISTS areas (
       id INTEGER PRIMARY KEY,
       areaname TEXT DEFAULT 'local',
       areapath TEXT DEFAULT '.',
       last_sync INTEGER DEFAULT 0,
       CONSTRAINT areaconstraint UNIQUE (areaname));

INSERT INTO areas (id,areaname,areapath) VALUES (0,'local','.');

CREATE TABLE IF NOT EXISTS ttype (
       id INTEGER PRIMARY KEY,
       target_spec TEXT DEFAULT '');
       
CREATE TABLE IF NOT EXISTS runs (
       id INTEGER PRIMARY KEY,
       target     TEXT DEFAULT '',
       ttype_id   INTEGER DEFAULT 0,
       runname    TEXT DEFAULT 'norun',
       state      TEXT DEFAULT '',
       status     TEXT DEFAULT '',
       owner      TEXT DEFAULT '',
       event_time INTEGER DEFAULT extract(epoch from now()),
       comment    TEXT DEFAULT '',
       fail_count INTEGER DEFAULT 0,
       pass_count INTEGER DEFAULT 0,
       last_update INTEGER DEFAULT extract(epoch from now()),
       area_id     INTEGER DEFAULT 0,
       CONSTRAINT runsconstraint UNIQUE (runname));

CREATE TABLE IF NOT EXISTS run_stats (
       id     INTEGER PRIMARY KEY,
       run_id INTEGER,
       state  TEXT,
       status TEXT,
       count  INTEGER,
       last_update INTEGER DEFAULT extract(epoch from now()));

CREATE TABLE IF NOT EXISTS test_meta (
       id          INTEGER PRIMARY KEY,
       testname    TEXT DEFAULT '',
       author      TEXT DEFAULT '',
       owner       TEXT DEFAULT '',
       description TEXT DEFAULT '',
       reviewed    TEXT,
       iterated    TEXT DEFAULT '',
       avg_runtime REAL,
       avg_disk    REAL,
       tags        TEXT DEFAULT '',
       jobgroup    TEXT DEFAULT 'default',
       CONSTRAINT test_meta_constraint UNIQUE (testname));

CREATE TABLE IF NOT EXISTS tasks_queue (
       id INTEGER PRIMARY KEY,
       action TEXT DEFAULT '',
       owner TEXT,
       state TEXT DEFAULT 'new',
       target TEXT DEFAULT '',
       name TEXT DEFAULT '',
       testpatt TEXT DEFAULT '',
       keylock TEXT,
       params TEXT,
       creation_time INTEGER DEFAULT extract(epoch from now()),
       execution_time INTEGER);

CREATE TABLE IF NOT EXISTS archive_disks (
       id INTEGER PRIMARY KEY,
       archive_area_name TEXT,
       disk_path TEXT,
       last_df INTEGER DEFAULT -1,
       last_df_time INTEGER DEFAULT extract(epoch from now()),
       creation_time INTEGER DEFAULT extract(epoch from now()));

CREATE TABLE IF NOT EXISTS archive_blocks (
       id INTEGER PRIMARY KEY,
       archive_disk_id INTEGER,
       disk_path TEXT,
       last_du INTEGER DEFAULT -1,
       last_du_time INTEGER DEFAULT extract(epoch from now()),
       creation_time INTEGER DEFAULT extract(epoch from now()));

CREATE TABLE IF NOT EXISTS archive_allocations (
       id INTEGER PRIMARY KEY,
       archive_block_id INTEGER,
       testname TEXT,
       item_path TEXT,
       creation_time INTEGER DEFAULT extract(epoch from now()));

CREATE TABLE IF NOT EXISTS extradat (
       id INTEGER PRIMARY KEY,
       run_id INTEGER,
       key TEXT,
       val TEXT);

CREATE TABLE IF NOT EXISTS metadat (
       id INTEGER PRIMARY KEY,
       var TEXT,
       val TEXT);

CREATE TABLE IF NOT EXISTS access_log (
       id INTEGER PRIMARY KEY,
       "user" TEXT,
       accessed TIMESTAMP,
       args TEXT);

CREATE TABLE tests  (
       id INTEGER PRIMARY KEY,                                                                            
       run_id       INTEGER   DEFAULT -1,                                                                 
       testname     TEXT      DEFAULT 'noname',                                                           
       host         TEXT      DEFAULT 'n/a',                                                              
       cpuload      REAL      DEFAULT -1,                                                                 
       diskfree     INTEGER   DEFAULT -1,                                                                 
       uname        TEXT      DEFAULT 'n/a',                                                              
       rundir       TEXT      DEFAULT '/tmp/badname',                                                     
       shortdir     TEXT      DEFAULT '/tmp/badname',                                                     
       item_path    TEXT      DEFAULT '',                                                                 
       state        TEXT      DEFAULT 'NOT_STARTED',                                                      
       status       TEXT      DEFAULT 'FAIL',                                                             
       attemptnum   INTEGER   DEFAULT 0,                                                                  
       final_logf   TEXT      DEFAULT 'logs/final.log',                                                   
       logdat       TEXT      DEFAULT '',                                                                 
       run_duration INTEGER   DEFAULT 0,                                                                  
       comment      TEXT      DEFAULT '',                                                                 
       event_time   INTEGER DEFAULT extract(epoch from now()),                                             
       fail_count   INTEGER   DEFAULT 0,                                                                  
       pass_count   INTEGER   DEFAULT 0,                                                                  
       archived     INTEGER   DEFAULT 0, -- 0=no, > 1=archive block id where test data can be found       
       last_update  INTEGER DEFAULT extract(epoch from now()),                                               
       CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path));  

CREATE TABLE IF NOT EXISTS test_steps (
       id INTEGER PRIMARY KEY,
       test_id INTEGER, 
       stepname TEXT, 
       state TEXT DEFAULT 'NOT_STARTED', 
       status TEXT DEFAULT 'n/a',
       event_time INTEGER DEFAULT extract(epoch from now()),
       comment TEXT DEFAULT '',
       logfile TEXT DEFAULT '',
       last_update  INTEGER DEFAULT extract(epoch from now()),
       CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));

CREATE TABLE IF NOT EXISTS test_data (
       id INTEGER PRIMARY KEY,
       test_id INTEGER,
       category TEXT DEFAULT '',
       variable TEXT,
       value REAL,
       expected REAL,
       tol REAL,
       units TEXT,
       comment TEXT DEFAULT '',
       status TEXT DEFAULT 'n/a',
       type TEXT DEFAULT '',
       last_update  INTEGER DEFAULT extract(epoch from now()),
       CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));

CREATE TABLE IF NOT EXISTS test_rundat (
       id           INTEGER PRIMARY KEY,
       test_id      INTEGER,
       update_time  INTEGER,
       cpuload      INTEGER DEFAULT -1,
       diskfree     INTEGER DEFAULT -1,
       diskusage    INTEGER DEFAULT -1,
       run_duration INTEGER DEFAULT 0);

CREATE TABLE IF NOT EXISTS archives (
       id           INTEGER PRIMARY KEY,
       test_id      INTEGER,
       state        TEXT DEFAULT 'new',
       status       TEXT DEFAULT 'n/a',
       archive_type TEXT DEFAULT 'bup',
       du           INTEGER,
       archive_path TEXT);
 

TRUNCATE archive_blocks, archive_allocations, extradat, metadat, access_log, tests, test_steps, test_data, test_rundat, archives, keys, runs, run_stats, test_meta, tasks_queue, archive_disks;

     srfi-18 extras format pkts regex
     (prefix dbi dbi:)) ;;  zmq extras)

(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses configf))
(declare (uses rmt))

(include "megatest-fossil-hash.scm")

(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtutilrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

Actions:
   run                     : initiate runs
   remove                  : remove runs
   rerun                   : register action for processing
   set-ss                  : set state/status
   archive                 : compress and move test data to archive disk
   kill                    : stop tests or entire runs
   db                      : database utilities

Contour actions:
   process                 : runs import, rungen and dispatch 

Selectors 
  -immediate               : apply this action immediately, default is to queue up actions
  -area areapatt1,area2... : apply this action only to the specified areas

  -set-vars V1=1,V2=2      : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -log logfile             : send stdout and stderr to logfile
  -repl                    : start a repl (useful for extending megatest)
  -load file.scm           : load and run file.scm
  -debug N|N,M,O...        : enable debug messages 0-N or N and M and O ...

Utility
  pgschema                 : emit postgresql schema; do \"mtutil db pgschema | psql -d mydb\"

Examples:

# Start a megatest run in the area \"mytests\"
mtutil -area mytests -action run -target v1.63/aa3e -mode-patt MYPATT -tag-expr quick

# Start a contour
mtutil run -contour quick -target v1.63/aa3e 

;; Add args that use remargs here
;;
(if (and (not (null? remargs))
	 (not (or
	       (args:get-arg "-runstep")
	       (args:get-arg "-envcap")
	       (args:get-arg "-envdelta")
	       (member *action* '("db"))   ;; very loose checks on db.
	       )))
    (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))

(if (or (args:any? "-h" "help" "-help" "--help")
	(member *action* '("-h" "-help" "--help" "help")))
    (begin
      (print help)

	   ((process)  (begin
			 (load-pkts-to-db mtconf)
			 (generate-run-pkts mtconf toppath)
			 (load-pkts-to-db mtconf)
			 (dispatch-commands mtconf toppath)))
	   ((import)   (load-pkts-to-db mtconf)) ;; import pkts
	   ((rungen)   (generate-run-pkts mtconf toppath))
	   ((dispatch) (dispatch-commands mtconf toppath)))))
      ((db)
       (if (null? remargs)
	   (print "ERROR: missing sub command for db command")
	   (let ((subcmd (car remargs)))
	     (case (string->symbol subcmd)
	       ((pgschema)
		(let* ((install-home (common:get-install-area))
		       (schema-file  (conc install-home "/share/db/mt-pg.sql")))
		  (if (file-exists? schema-file)
		      (system (conc "/bin/cat " schema-file)))))
	       ((junk)
		(rmt:get-keys))))))))

(if (or (args:get-arg "-repl")
	(args:get-arg "-load"))
    (begin
      (import extras) ;; might not be needed
      ;; (import csi)
      (import readline)