Megatest

  -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 ...
  -list-pkt-keys             : list all pkt keys
			     
Utility			     
 db pgschema                 : emit postgresql schema; do \"mtutil db pgschema | psql -d mydb\"
 gatherdb [propagate]        : gather dbs from all areas into /tmp/$USER_megatest/alldbs,
                               optionally propagate the data to megatest2.0 format
 

Examples:

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

# Start a contour

    ;; we set some dynamic data in a section called "scratchdata"
    (if mtconf
	(begin
	  (configf:section-var-set! mtconf "scratchdat" "toppath" start-dir)))
    ;; (print "TOPPATH: " (configf:lookup mtconf "scratchdat" "toppath"))
    mtconfdat))

;;======================================================================
;; Areas
;;======================================================================

;; look for areas=a1,a2,a3 OR areafn=somefuncname
;;
(define (val-alist->areas val-alist)
  (let ((areas-string   (alist-ref 'areas  val-alist))
	(areas-procname (alist-ref 'areafn val-alist)))
    (if areas-procname ;; areas-procname take precedence
	areas-procname
	(string-split (or areas-string "") ","))))

;; area   - the current area under consideration
;; areas  - the list of allowed areas from the contour spec -OR-
;;          if it is a string then it is the function to use to
;;          lookup in *area-checkers*
;;
(define (area-allowed? area areas runkey contour mode-patt)
  (cond
   ((not areas) #t) ;; no spec
   ((string? areas) ;; 
    (let ((check-fn (hash-table-ref/default *area-checkers* (string->symbol areas) #f)))
      (if check-fn
	  (check-fn area runkey contour mode-patt)
	  #f)))
   ((list? areas)(member area areas))
   (else #f))) ;; shouldn't get here 

(define (get-area-names mtconf)
  (map car (configf:get-section mtconf "areas")))

;;======================================================================
;; Pkts for remote control
;;======================================================================

;; NEED TIMESTAMP ON PKTS for efficient loading of packets into db.


;; make a run request pkt from basic data, this seriously needs to be refactored
;;   i. Take the code that builds the info to submit to create-run-pkt and have it
;;      generate the pkt keys directly.

                   extra-dat: `(a ,runkey)  ;; we need the run key for marking the run as launched
                   )))
      (with-output-to-file
	  (conc pktsdir "/" uuid ".pkt")
	(lambda ()
	  (print pkt))))))

;; look for areas=a1,a2,a3 OR areafn=somefuncname
;;
(define (val-alist->areas val-alist)
  (let ((areas-string   (alist-ref 'areas  val-alist))
	(areas-procname (alist-ref 'areafn val-alist)))
    (if areas-procname ;; areas-procname take precedence
	areas-procname
	(string-split (or areas-string "") ","))))

;; area   - the current area under consideration
;; areas  - the list of allowed areas from the contour spec -OR-
;;          if it is a string then it is the function to use to
;;          lookup in *area-checkers*
;;
(define (area-allowed? area areas runkey contour mode-patt)
  (cond
   ((not areas) #t) ;; no spec
   ((string? areas) ;; 
    (let ((check-fn (hash-table-ref/default *area-checkers* (string->symbol areas) #f)))
      (if check-fn
	  (check-fn area runkey contour mode-patt)
	  #f)))
   ((list? areas)(member area areas))
   (else #f))) ;; shouldn't get here 

;; (use trace)(trace create-run-pkt)

;; collect all needed data and create run pkts for contours with changed inputs
;;
(define (generate-run-pkts mtconf toppath)
  (let ((std-runname (conc "sched"  (time->string (seconds->local-time (current-seconds)) "%M%H%d"))))
    (common:with-queue-db

           (let ((portnum (string->number (car remargs))))
              
             (if (not portnum)
                 (print "ERROR: the portnumber parameter must be a number, you gave: " (car remargs))
                 (begin
                   (if (not (is-port-in-use portnum))  
                       (let* ((rep       (start-nn-server portnum))
                           (mtconfdat (simple-setup (args:get-arg "-start-dir")))
                           (mtconf    (car mtconfdat))
                           (script    (configf:lookup mtconf "listener" "script")))
                           (print "Listening on port " portnum " for messages")
														(set-signal-handler! signal/int  special-signal-handler)
														(set-signal-handler! signal/term special-signal-handler)

                            (let loop ((instr (nn-recv rep)))
                               (print "received " instr ", running \"" script " " instr "\"")
                               (system (conc script " '" instr "'"))
                               (nn-send rep "ok")
                               (loop (nn-recv rep))))
                              (mtconfdat (simple-setup (args:get-arg "-start-dir")))
                              (mtconf    (car mtconfdat))
                              (script    (configf:lookup mtconf "listener" "script")))
                         (print "Listening on port " portnum " for messages")
                         (set-signal-handler! signal/int  special-signal-handler)
                         (set-signal-handler! signal/term special-signal-handler)
                         
                         (let loop ((instr (nn-recv rep)))
                           (print "received " instr ", running \"" script " " instr "\"")
                           (system (conc script " '" instr "'"))
                           (nn-send rep "ok")
                           (loop (nn-recv rep))))
		       (print "ERROR: Port " portnum " already in use. Try another port")))))))
      ((gather) ;; gather all area db's into /tmp/$USER_megatest/alldbs
       (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
              (mtconf    (car mtconfdat))
              (areas     (get-area-names mtconf)))
         (print "areas: " areas)))
      
      (else
       (let ((all-actions (sort (map conc (delete-duplicates (append *other-actions* (map car *action-keys*)))) string<=?)))
	 (print "unrecognised action: \"" *action* "\", try one of; \"" (string-intersperse all-actions "\", \"") "\"")))
      
      )) ;; the end