Megatest

Diff
Login

Differences From Artifact [15f0835800]:

To Artifact [7587db552f]:


18
19
20
21
22
23
24
25
26
27
28
29
30
31







32
33
34
35
36
37
38
18
19
20
21
22
23
24







25
26
27
28
29
30
31
32
33
34
35
36
37
38







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








;;======================================================================

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

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

(include "common_records.scm")
;; (use regex regex-case matchable) ;;  directory-utils)
;; (declare (unit configf))
;; (declare (uses process))
;; (declare (uses env))
;; (declare (uses keys))
;; 
;; (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? cfname)
	    (list toppath cfname configname)
356
357
358
359
360
361
362
363

364
365
366
367
368
369
370
356
357
358
359
360
361
362

363
364
365
366
367
368
369
370







-
+







				       (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
					     curr-section-name #f #f))))
	       (configf:script-rx ( x include-script params);; handle-exceptions
                                  ;;    exn
                                  ;;    (begin
                                  ;;      (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.")
                                  ;;      (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
                                  (if (and (common:file-exists? include-script)(file-execute-access? include-script))
                                  (if (and (common:file-exists? include-script)(file-executable? include-script))
                                      (let* ((local-allow-system  (calc-allow-system allow-system curr-section-name sections))
                                             (env-delta  (configf:cfgdat->env-alist curr-section-name res local-allow-system))
                                             (new-inp-port
                                              (common:with-env-vars
                                               env-delta
                                               (lambda ()
                                                 (open-input-pipe (conc include-script " " params))))))
715
716
717
718
719
720
721
722

723
724
725
726
727
728
729
715
716
717
718
719
720
721

722
723
724
725
726
727
728
729







-
+








;; reads a refdb into an assoc array of assoc arrays
;;   returns (list dat msg)
(define (configf:read-refdb refdb-path)
  (let ((sheets-file  (conc refdb-path "/sheet-names.cfg")))
    (if (not (common:file-exists? sheets-file))
	(list #f (conc "ERROR: no refdb found at " refdb-path))
	(if (not (file-read-access? sheets-file))
	(if (not (file-readable? sheets-file))
	    (list #f (conc "ERROR: refdb file not readable at " refdb-path))
	    (let* ((sheets (with-input-from-file sheets-file
			     (lambda ()
			       (let loop ((inl (read-line))
					  (res '()))
				 (if (eof-object? inl)
				     (reverse res)