Megatest

;; Config file handling
;;======================================================================

(use regex regex-case matchable) ;;  directory-utils)
(declare (unit configf))
(declare (uses process))
(declare (uses env))

(declare (uses commonmod))
(import commonmod)

(declare (uses configfmod))
(import configfmod)

(include "common_records.scm")

;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
  (if toppath
      (let ((cfname (conc toppath "/" configname)))

	    (if (common:file-exists? fullpath)
		(list path fullpath configname)
		(let ((remcwd (take dir (- (length dir) 1))))
		  (if (null? remcwd)
		      (list #f #f #f) ;;  #f #f) 
		  (loop remcwd)))))))))













(define (configf:eval-string-in-environment str)
  ;; (if (or (string-null? str)
  ;;	  (equal? "!" (substring str 0 1))) ;; null string or starts with ! are preserved but NOT set in the environment
      str
      (handle-exceptions
       exn
       (begin

				((mtrah)      (conc "(lambda (ht)"
                                                    "    (let ((extra \"" cmd "\"))"
						    "       (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
						    "             (if (string-null? extra) \"\" \"/\")"
						    "             extra)))"))
				((get g)   
				 (match (string-split cmd)
					((sect var)(conc "(lambda (ht)(configfmod#configf:lookup ht \"" sect "\" \"" var "\"))"))
					(else
					 (debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.")
					 "(lambda (ht) #f)")))
				((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
				;; ((rget)           (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
				(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
		;; (print "fullcmd=" fullcmd)

    (if toppath (change-directory toppath)) 
    (if (and toppath pathenvvar)(setenv pathenvvar toppath))
    (let ((configdat  (if configfile 
			  (read-config configfile #f #t environ-patt: environ-patt post-section-procs: (list (cons "^fields$" set-fields)) #f))))
      (if toppath (change-directory curr-dir))
      (list configdat toppath configfile fname))))

;;======================================================================
;; lookup and manipulation routines
;;======================================================================

;; (define (configf:assoc-safe-add alist key val #!key (metadata #f))
;;   (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
;;     (append newalist (list (if metadata
;; 			       (list key val metadata)
;; 			       (list key val))))))
;; 
;; (define (configf:section-var-set! cfgdat section-name var value #!key (metadata #f))
;;   (hash-table-set! cfgdat section-name
;; 		   (configf:assoc-safe-add
;; 		    (hash-table-ref/default cfgdat section-name '())
;; 		    var value metadata: metadata)))
;; 
;; (define (configf:lookup cfgdat section var)
;;   (if (hash-table? cfgdat)
;;       (let ((sectdat (hash-table-ref/default cfgdat section '())))
;; 	(if (null? sectdat)
;; 	    #f
;; 	    (let ((match (assoc var sectdat)))
;; 	      (if match ;; (and match (list? match)(> (length match) 1))
;; 		  (cadr match)
;; 		  #f))
;; 	    ))
;;       #f))
;; 
;; ;; use to have definitive setting:
;; ;;  [foo]
;; ;;  var yes
;; ;;
;; ;;  (configf:var-is? cfgdat "foo" "var" "yes") => #t
;; ;;
;; (define (configf:var-is? cfgdat section var expected-val)
;;   (equal? (configf:lookup cfgdat section var) expected-val))
;; 

;; (define config-lookup configf:lookup)
(define configf:read-file read-config)

;; ;; safely look up a value that is expected to be a number, return
;; ;; a default (#f unless provided)
;; ;;
;; (define (configf:lookup-number cfdat section varname #!key (default #f))
;;   (let* ((val (configf:lookup *configdat* section varname))
;;          (res (if val
;;                   (string->number (string-substitute "\\s+" "" val #t))
;;                   #f)))
;;     (cond
;;      (res  res)
;;      (val  (debug:print 0 *default-log-port* "ERROR: no number found for [" section "], " varname ", got: " val))
;;      (else default))))
;; 
;; (define (configf:section-vars cfgdat section)
;;   (let ((sectdat (hash-table-ref/default cfgdat section '())))
;;     (if (null? sectdat)
;; 	'()
;; 	(map car sectdat))))
;; 
;; (define (configf:get-section cfgdat section)
;;   (hash-table-ref/default cfgdat section '()))
;; 
;; (define (configf:set-section-var cfgdat section var val)
;;   (let ((sectdat (configf:get-section cfgdat section)))
;;     (hash-table-set! cfgdat section
;;                      (configf:assoc-safe-add sectdat var val))))
;; 

;;     ;;(append (filter (lambda (x)(not (assoc var sectdat))) sectdat)
;;     ;;	    (list var val))))
;; 
;;======================================================================
;; setup
;;======================================================================
;;======================================================================

(define (setup)
  (let* ((configf (find-config "megatest.config"))
	 (config  (if configf (read-config configf #f #t) #f)))
    (if config
	(setenv "RUN_AREA_HOME" (pathname-directory configf)))
    config))