Megatest

;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
;;
(define (common:load-views-config)
  (let* ((view-cfgdat    (make-hash-table))
	 (home-cfgfile   (conc (get-environment-variable "HOME") "/.mtviews.config"))
	 (mthome-cfgfile (conc *toppath* "/.mtviews.config")))
    (if (common:file-exists? mthome-cfgfile)
	(configf:read-config mthome-cfgfile view-cfgdat))
	(configf:read-config mthome-cfgfile view-cfgdat #t))
    ;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas
    (if (common:file-exists? home-cfgfile)
	(configf:read-config home-cfgfile view-cfgdat #t))
    view-cfgdat))

;;======================================================================
;; H I E R A R C H I C A L   H A S H   T A B L E S

	     (rxstr (if (string-contains section-name "%")
			(string-substitute (regexp "%") ".*" section-name)
			(string-substitute (regexp "^/(.*)/$") "\\1" section-name)))
	     (rx    (regexp rxstr)))
	;; (print "\nsection-name: " section-name " rxstr: " rxstr)
        (for-each
         (lambda (section)
	   (if section
	   (if (string? section)
	       (let ((same-section (string=? section-name section))
		     (rx-match     (string-match rx section)))
		 ;; (print "section: " section " vars: " vars " same-section: " same-section " rx-match: " rx-match)
		 (if (and (not same-section) rx-match)
		     (for-each
		      (lambda (bundle)
			;; (print "bundle: " bundle)

;;    'return-string -- return a string representing a proc taking ht as an argument that may be evaulated at some future time
;; envion-patt is a regex spec that identifies sections that will be eval'd
;; in the environment on the fly
;; sections: #f => get all, else list of sections to gather
;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path)
;; apply-wildcards: #t/#f - apply vars from targets with % wildcards to all matching sections
;;
(define (configf:read-config path ht allow-system #!key (environ-patt #f)            (curr-section #f)   
		     (sections #f)              (settings (make-hash-table)) (keep-filenames #f)
		     (post-section-procs '())   (apply-wildcards #t) (env-to-use #f))
(define (configf:read-config path ht allow-system
			     #!key (environ-patt #f)  (curr-section #f)   
			     (sections #f)            (settings (make-hash-table))
			     (keep-filenames #f)      (post-section-procs '())
			     (apply-wildcards #t)     (env-to-use #f))
  (debug:print 9 *default-log-port* "START: " path)
;; (if *configdat*
;;     (common:save-pkt `((action . read-config)
;;       		 (f      . ,(cond ((string? path) path)
;;       				  ((port?   path) "port")
;;       				  (else (conc path))))
;;                        (T      . configf))
;;       	       *configdat* #t add-only: #t))
  (if (and (not (port? path))
	   (not (file-exists? path))) ;; for case where we are handed a port
      (begin 
	(debug:print-info 1 *default-log-port* "configf:read-config - file not found " path " current path: " (current-directory))
	;; WARNING: This is a risky change but really, we should not return an empty hash table if no file read?
	#f) ;; (if (not ht)(make-hash-table) ht))
      (let (;; (env-to-use (if env-to-use env-to-use (module-environment 'configfmod)))
	    (inp        (if (string? path)
			    (open-input-file path)
			      path)) ;; we can be handed a port
	    (res        (let ((ht-in (if (not ht)
	    (res        (if (not ht)(make-hash-table) ht))
					 (make-hash-table)
					 ht)))
			  (if (not (hash-table-exists? ht-in 'metadata))
			      (begin
				(hash-table-set! ht-in 'metadata (make-hash-table))
				(hash-table-set! (hash-table-ref ht-in 'metadata) 'toppath path)))
			  ht-in))
	    (metapath   (if (or (debug:debug-mode 9)
				keep-filenames)
			    path #f))
            (process-wildcards  (lambda (res curr-section-name)
                                  (if (and apply-wildcards
                                           (or (string-contains curr-section-name "%")   ;; wildcard
                                               (string-match "/.*/" curr-section-name))) ;; regex

;; convert hierarchial list to ini format
;;
(define (configf:config->ini data)
  (map 
   (lambda (section)
     (let ((section-name (car section))
	   (section-dat  (cdr section)))
       (if (string? section-name)
	   (begin
       (print "\n[" section-name "]")
       (map (lambda (dat-pair)
	      (let* ((var (car dat-pair))
		     (val (cadr dat-pair))
		     (fname (if (> (length dat-pair) 2)(caddr dat-pair) #f)))
		(if fname (print "# " var "=>" fname))
		(print var " " val)))
	    section-dat))) ;;       (print "section-dat: " section-dat))
	     (print "\n[" section-name "]")
	     (map (lambda (dat-pair)
		    (let* ((var (car dat-pair))
			   (val (cadr dat-pair))
			   (fname (if (> (length dat-pair) 2)(caddr dat-pair) #f)))
		      (if fname (print "# " var "=>" fname))
		      (print var " " val)))
		  section-dat))))) ;;       (print "section-dat: " section-dat))
   (hash-table->alist data)))

(define (runconfig:read fname target environ-patt)
  (let ((ht (make-hash-table)))
    (if target (hash-table-set! ht target '()))
    (configf:read-config fname ht #t environ-patt: environ-patt sections: (if target (list "default" target) #f))))

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

;; convert to param?
(define configf:std-imports "(import big-chicken configfmod commonmod rmtmod)")
(define configf:std-imports "(import big-chicken configfmod commonmod rmtmod (prefix mtargs args:))")
(define (configf:process-one matchdat l ht allow-system env-to-use linenum)
  (let* ((prestr  (list-ref matchdat 1))
	 (cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
	 (cmd     (list-ref matchdat 3))
	 (quotedcmd (conc "\""cmd"\""))
	 (poststr (list-ref matchdat 4))
	 (result  #f)
	 (start-time (current-seconds))
	 (cmdsym  (string->symbol cmdtype))
	 (fullcmd
	  (if (member cmdsym '(scheme scm))
	      `(eval-needed
		,(conc  "(lambda (ht)"
			configf:std-imports
			cmd ")"))
	      (case cmdsym
		((system)     `(noeval-needed  ,(conc (configf:system ht quotedcmd))))
		((shell sh)   `(noeval-needed  ,(conc (string-translate (shell quotedcmd) "\n" " "))))
		((system)     `(noeval-needed  ,(conc (configf:system ht cmd))))
		;; ((shell sh)   `(noeval-needed  ,(conc (string-translate (shell quotedcmd) "\n" " "))))
		((shell sh)   `(noeval-needed  ,(conc (string-translate (shell cmd) "\n" " "))))
		((realpath rp)`(noeval-needed  ,(conc (common:nice-path quotedcmd))))
		((getenv gv)  `(noeval-needed  ,(conc (get-environment-variable cmd))))
		;; TODO - replace *toppath* and var reliance with getting path where *this* config file was found
		;; ((mtrah)      (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))))
		((mtrah)      `(noeval-needed  ,(hash-table-ref (hash-table-ref ht 'metadata) 'toppath)))   ;; (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))))
		((get g)   
		 (match
		  (string-split cmd)
		  ((sect var) `(noeval-needed ,(configf:lookup ht sect var)))
		  (else
		   (debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.")
		   '(bad-param ,(conc "#{get ...} used with only one parameter, \"" cmd "\", two needed.")))))

(module megatest-main
	*

  (import scheme
	  chicken.base
	  chicken.bitwise
	  chicken.condition
	  ;; chicken.csi
	  chicken.eval
	  chicken.file
	  chicken.file.posix
	  chicken.format
	  chicken.io
	  chicken.irregex
	  chicken.pathname

		 ;; EOF
		 
		 (repl))
		(else
		 (begin
		   ;; (set! *db* dbstruct)
		   ;; (import extras) ;; might not be needed
		   ;; (import csi)
		   ;; (import chicken.csi)
		   ;; (import readline)
		   (import apropos
		   #;(import apropos
			   archivemod
			   commonmod
			   configfmod
			   dbmod
			   debugprint
			   ezstepsmod
			   launchmod
			   processmod
			   rmtmod
			   runsmod
			   servermod
			   tasksmod
			   testsmod)
		   
		   (set-history-length! 300)
		   
		   (load-history-from-file ".megatest_history")
		   
		   (current-input-port (make-linenoise-port))
		   ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
		   
		   ;; (if *use-new-readline*
		   ;; 	  (begin
		   ;; 	    (install-history-file (get-environment-variable "HOME") ".megatest_history") ;;  [homedir] [filename] [nlines])
		   ;; 	    (current-input-port (make-readline-port "megatest> ")))