Megatest

(include "dbi/dbi.scm")
(include "stml2/cookie.scm")
(include "stml2/stml2.scm")
(include "pkts/pkts.scm")
(include "csv-xml/csv-xml.scm")
(include "ducttape/ducttape-lib.scm")
(include "hostinfo/hostinfo.scm")
(include "adjutant.scm")

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

(module megatest-main
	*

	(import scheme

		
		(prefix sqlite3 sqlite3:)
		(prefix base64 base64:)
		address-info
		csv-abnf
		directory-utils
		fmt
		json
		matchable
		md5
		message-digest
		queues
		regex
		regex-case
		sql-de-lite
		stack
		typed-records
		s11n
		sparse-vectors
		sxml-serializer
		sxml-modifications
		system-information
		z3
		spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing
		
		srfi-1
		srfi-4
		srfi-18
		srfi-13
		srfi-98
		srfi-69

		;; local modules
		mutils
		csv-xml
		ducttape-lib
		hostinfo
		adjutant
		)
	
;; (include "common.scm")
(include "megatest-version.scm")

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

;; (use sparse-vectors)
;; 
;; (require-library mutils)

;; copied from egg call-with-environment-variables
;;
(define (call-with-environment-variables variables thunk)
  ;; @("Sets up environment variable via dynamic-wind which are taken down after thunk."
  ;;   (variables "An alist of the form {{'((\"var\" . \"value\") ...)}}")
  ;;   (thunk "The thunk to execute with a modified environment"))
  (let ((pre-existing-variables
         (map (lambda (var-value)
                (let ((var (car var-value)))
                  (cons var (get-environment-variable var))))
              variables)))
    (dynamic-wind
        (lambda () (void))

			 (debug:print 0 *default-log-port* "WARNING: log file " logpath-in " path too long, converted to " newlogf)
			 newlogf)
		       logpath-in)))
     (if (not (directory-exists? log-dir))
         (system (conc "mkdir -p " log-dir)))
     (open-output-file logpath))
   (exn ()
        (debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath-in)
        (define *didsomething* #t)  
        (exit 1))))

;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;

;; == duplicated == 		     user
;; == duplicated == 		     args:arg-hash))))

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

;; (if (args:get-arg "-rollup")
;;     (general-run-call 
;;      "-rollup" 
;;      "rollup tests" 
;;      (lambda (target runname keys keyvals)
;;        (runs:rollup-run keys
;; 			keyvals
;; 			(or (args:get-arg "-runname")(args:get-arg ":runname") )
;; 			user))))

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

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

(if (args:get-arg "-mark-incompletes")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 *default-log-port* "Failed to setup, exiting")
	    (exit 1)))
      (rmt:find-and-mark-incomplete #f)
      (set! *didsomething* #t)))

;;======================================================================
;; Update the tests meta data from the testconfig files
;;======================================================================

(if (args:get-arg "-update-meta")