Megatest

Diff
Login

Differences From Artifact [c034045a40]:

To Artifact [449e48b127]:


47
48
49
50
51
52
53
54

55
56
57
58
59
60
61
47
48
49
50
51
52
53

54
55
56
57
58
59
60
61







-
+







(define (configf:section-var-set! cfgdat section-name var value #!key (metadata #f))
  (hash-table-set! cfgdat section-name
		   (config:assoc-safe-add
		    (hash-table-ref/default cfgdat section-name '())
		    var value metadata: metadata)))

(define (config:eval-string-in-environment str)
  (handle-exceptions
  (common:debug-handle-exceptions #t
   exn
   (begin
     (debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment")
     #f)
   (let ((cmdres (process:cmd-run->list (conc "echo " str))))
     (if (null? cmdres) ""
	 (caar cmdres)))))
107
108
109
110
111
112
113
114

115
116
117
118
119
120
121
107
108
109
110
111
112
113

114
115
116
117
118
119
120
121







-
+







					(sect  (car parts))
					(var   (cadr parts)))
				   (conc "(lambda (ht)(config-lookup ht \"" sect "\" \"" var "\"))")))
				((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)
		(handle-exceptions
		(common:debug-handle-exceptions #t
		 exn
		 (begin
		   (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\"")
		   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
		   ;; (print "exn=" (condition->list exn))
		   (set! result (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd)))
		 (if (or allow-system
651
652
653
654
655
656
657

658



659
660


661
662

663
664
665
666











667
668
669
670
671
672
673
651
652
653
654
655
656
657
658
659
660
661
662


663
664
665
666
667




668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685







+

+
+
+
-
-
+
+


+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+







  (let ((ht (make-hash-table)))
    (for-each
     (lambda (section)
       (hash-table-set! ht (car section)(cdr section)))
     adat)
    ht))

;; if 
(define (configf:read-alist fname)
  (handle-exceptions
      exn
      #f
  (configf:alist->config
   (with-input-from-file fname read)))
    (configf:alist->config
     (with-input-from-file fname read))))

(define (configf:write-alist cdat fname)
  (let ((dat  (configf:config->alist cdat)))
  (with-output-to-file fname
    (lambda ()
      (pp (configf:config->alist cdat)))))
     
    (with-output-to-file fname ;; first write out the file
      (lambda ()
	(pp dat)))
    (if (file-exists? fname)   ;; now verify it is readable
	(if (configf:read-alist fname)
	    #t ;; data is good.
	    (begin
	      (delete-file fname)
	      (debug:print 0 *default-log-port* "WARNING: content " dat " for cache " fname " is not readable. Deleting generated file.")
	      #f))
	#f)))

;; convert hierarchial list to ini format
;;
(define (configf:config->ini data)
  (map 
   (lambda (section)
     (let ((section-name (car section))