Megatest

Usage: megatest [options]
  -h                      : this help

Launching and managing runs
  -runall                 : run all tests that are not state COMPLETED and status PASS, 
                            CHECK or KILLED
  -runtests tst1,tst2 ... : run tests
  -remove-runs            : remove the data for a run, requires :runname and -testpatt
                            Optionally use :state and :status
  -set-state-status X,Y   : set state to X and status to Y, requires controls per -remove-runs
  -rerun FAIL,WARN...     : force re-run for tests with specificed status(s)
  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
                            from prior runs with same keys
  -lock                   : lock run specified by target and runname
  -unlock                 : unlock run specified by target and runname

Selectors (e.g. use for -runtests, -remove-runs, -set-state-status, -list-runs etc.)
  -target key1/key2/...   : run for key1, key2, etc.
  -reqtarg key1/key2/...  : run for key1, key2, etc. but key1/key2 must be in runconfig

  -testpatt patt1/patt2,patt3/...  : % is wildcard
  :runname                : required, name for this particular test run
  :state                  : Applies to runs, tests or steps depending on context
  :status                 : Applies to runs, tests or steps depending on context

Test helpers (for use inside tests)
  -step stepname
  -test-status            : set the state and status of a test (use :state and :status)

  -update-meta            : update the tests metadata for all tests
  -env2file fname         : write the environment to fname.csh and fname.sh
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -repl                   : start a repl (useful for extending megatest)



Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style

			"-rebuild-db"
			"-rollup"
			"-update-meta"
			"-gen-megatest-area"

			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only

		       )
		 args:arg-hash
		 0))

(if (args:get-arg "-h")
    (begin
      (print help)

		   ((args:get-arg "-q")    0)
		   (else                   1)))

(if (not (number? *verbosity*))
    (begin
      (print "ERROR: Invalid debug value " (args:get-arg "-debug"))
      (exit)))
 
(if (args:get-arg "-logging")(set! *logging* #t))

(if (> *verbosity* 3) ;; we are obviously debugging
    (set! open-run-close open-run-close-no-exception-handling))

;; to try and not burden Kim too much...
(if (args:get-arg "-itempatt")
    (let ((old-testpatt (args:get-arg "-testpatt")))
      (debug:print 0 "ERROR: parameter \"-itempatt\" has been deprecated. For now I will tweak your -testpatt for you")
      (hash-table-set! args:arg-hash "-testpatt" (conc old-testpatt "/" (args:get-arg "-itempatt")))
      (debug:print 0 "    old: " old-testpatt ", new: " (args:get-arg "-testpatt"))
      (if (args:get-arg "-runtests")
	  (begin
	    (debug:print 0 "NOTE: Also modifying -runtests")
	    (hash-table-set! args:arg-hash "-runtests" (conc (args:get-arg "-runtests") "/" 
							     (args:get-arg "-itempatt")))))
      ))

;;======================================================================
;; Misc general calls
;;======================================================================

(if (args:get-arg "-env2file")
    (begin

  (cond
   ((not (args:get-arg ":runname"))
    (debug:print 0 "ERROR: Missing required parameter for " action ", you must specify the run name pattern with :runname patt")
    (exit 2))
   ((not (args:get-arg "-testpatt"))
    (debug:print 0 "ERROR: Missing required parameter for " action ", you must specify the test pattern with -testpatt")
    (exit 3))



   (else
    (if (not (car *configinfo*))
	(begin
	  (debug:print 0 "ERROR: Attempted " action "on test(s) but run area config file not found")
	  (exit 1))
	;; put test parameters into convenient variables
	(runs:operate-on  action
			  (args:get-arg ":runname")
			  (args:get-arg "-testpatt")

			  state: (args:get-arg ":state") 
			  status: (args:get-arg ":status")
			  new-state-status: (args:get-arg "-set-state-status")))
    (set! *didsomething* #t))))
	  
(if (args:get-arg "-remove-runs")
    (general-run-call 

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

(if (args:get-arg "-list-runs")
    (if (setup-for-run)
	(let* ((db       #f)
	       (runpatt  (args:get-arg "-list-runs"))
	       (testpatt (args:get-arg "-testpatt"))

	       (runsdat  (open-run-close db:get-runs db runpatt #f #f '()))
	       (runs     (db:get-rows runsdat))
	       (header   (db:get-header runsdat))
	       (keys     (open-run-close db:get-keys db))
	       (keynames (map key:get-fieldname keys)))
	  ;; Each run
	  (for-each 
	   (lambda (run)
	     (debug:print 1 "Run: "
			  (string-intersperse (map (lambda (x)
						     (db:get-value-by-header run header x))
						   keynames) "/")
			  "/"
			  (db:get-value-by-header run header "runname")
			  " status: " (db:get-value-by-header run header "state"))
	     (let ((run-id (open-run-close db:get-value-by-header run header "id")))
	       (let ((tests (open-run-close db:get-tests-for-run db run-id testpatt '() '())))
		 ;; Each test
		 (for-each 
		  (lambda (test)
		    (format #t
			    "  Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
			    (conc (db:test-get-testname test)
				  (if (equal? (db:test-get-item-path test) "")

		     args:arg-hash))))

;;======================================================================
;; Rollup into a run
;;======================================================================

(if (args:get-arg "-rollup")
    (begin
      (debug:print 0 "ERROR: Rollup is currently not working. If you need it please submit a ticket at http://www.kiatoa.com/fossils/megatest")
      (exit 4)))
;;     (general-run-call 
;;      "-rollup" 
;;      "rollup tests" 
;;      (lambda (target runname keys keynames keyvallst)
;;        (runs:rollup-run keys
;; 			(keys->alist keys "na")
;; 			(args:get-arg ":runname") 
;; 			user))))

;;======================================================================
;; Lock or unlock a run
;;======================================================================

(if (or (args:get-arg "-lock")(args:get-arg "-unlock"))
    (general-run-call 

	      (begin
		(debug:print 0 "ERROR: -target is required.")
		(exit 1)))
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, giving up on -test-paths or -test-files, exiting")
		(exit 1)))

	  (let* ((keys     (open-run-close db:get-keys db))
		 (keynames (map key:get-fieldname keys))
		 (paths    (open-run-close db:test-get-paths-matching db keynames target (args:get-arg "-test-files"))))
	    (set! *didsomething* #t)
	    (for-each (lambda (path)
			(print path))
		      paths)))
	;; else do a general-run-call