| ︙ | | |
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
-
+
|
;; (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))
;; redefines
(define config-lookup configf:lookup)
(define configf:read-file read-config)
;; (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 cfdat section varname))
(res (if val
|
| ︙ | | |
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
|
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
|
-
+
-
+
-
+
|
;; '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 (read-config path ht allow-system #!key (environ-patt #f) (curr-section #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* "read-config - file not found " path " current path: " (current-directory))
(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)))
(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 (if (not ht)(make-hash-table) ht))
(metapath (if (or (debug:debug-mode 9)
keep-filenames)
path #f))
|
| ︙ | | |
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
|
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
|
-
+
-
-
+
+
|
(begin
(debug:print '(2 9) #f "INFO: include file(s) matching " include-file " not found (called from " path ")")
(debug:print 2 *default-log-port* " " full-conf))
(for-each
(lambda (fpath)
;; (push-directory conf-dir)
(debug:print 9 *default-log-port* "Including: " full-conf)
(read-config fpath res allow-system environ-patt: environ-patt
(configf:read-config fpath res allow-system environ-patt: environ-patt
curr-section: curr-section-name sections: sections settings: settings
keep-filenames: keep-filenames))
all-matches))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings env-to-use)
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 (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))))))
(debug:print '(2 9) *default-log-port* "Including from script output: " include-script)
;; (print "We got here, calling read-config next. Port is: " new-inp-port)
(read-config new-inp-port res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames)
;; (print "We got here, calling configf:read-config next. Port is: " new-inp-port)
(configf:read-config new-inp-port res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames)
(close-input-port new-inp-port)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings env-to-use) curr-section-name #f #f))
(begin
(debug:print 0 *default-log-port* "Script not found or not exectutable: " include-script)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings env-to-use) curr-section-name #f #f)))
) ;; )
(configf:section-rx ( x section-name )
|
| ︙ | | |
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
|
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
|
-
+
|
(and (not (string-null? key))
(not (equal? "!" (substring key 0 1)))) ;; ! as leading character is a signature to NOT export to the environment
;; (string-match "^.*:.*:.*$" key) ;; ;; something:something:something reserved for triggers in runconfigs
))
(realval (if envar
(configf:eval-string-in-environment val)
val)))
(debug:print-info 6 *default-log-port* "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
(debug:print-info 6 *default-log-port* "configf:read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
(if envar (safe-setenv key realval))
(debug:print 10 *default-log-port* " setting: [" curr-section-name "] " key " = " val)
(hash-table-set! res curr-section-name
(configf:assoc-safe-add alist key realval metadata: metapath))
(loop (configf:read-line inp res
(calc-allow-system allow-system curr-section-name sections) settings env-to-use)
curr-section-name key #f)))
|
| ︙ | | |
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
|
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
|
-
+
|
;;======================================================================
;; setup
;;======================================================================
;;======================================================================
(define (setup)
(let* ((configf (find-config "megatest.config"))
(config (if configf (read-config configf #f #t) #f)))
(config (if configf (configf:read-config configf #f #t) #f)))
(if config
(setenv "RUN_AREA_HOME" (pathname-directory configf)))
config))
(define (safe-setenv key val)
(if (or (substring-index "!" key)
(substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables.
|
| ︙ | | |
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
|
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
|
-
+
|
(if (eof-object? inl)
(reverse res)
(loop (read-line)(cons inl res)))))))
(data '()))
(for-each
(lambda (sheet-name)
(let* ((dat-path (conc refdb-path "/" sheet-name ".dat"))
(ref-dat (configf:read-file dat-path #f #t))
(ref-dat (configf:read-config dat-path #f #t))
(ref-assoc (map (lambda (key)
(list key (hash-table-ref ref-dat key)))
(hash-table-keys ref-dat))))
;; (hash-table->alist ref-dat)))
;; (set! data (append data (list (list sheet-name ref-assoc))))))
(set! data (cons (list sheet-name ref-assoc) data))))
sheets)
|
| ︙ | | |
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
|
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
|
-
+
|
(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 '()))
(read-config fname ht #t environ-patt: environ-patt sections: (if target (list "default" target) #f))))
(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 configfmod commonmod)")
|
| ︙ | | |
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
|
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
|
+
-
+
+
+
|
(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
(not (member cmdtype '("system" "shell" "sh"))))
(with-input-from-string fullcmd
(lambda ()
(set! result (if env-to-use
(set! result ((eval (read) env-to-use) ht))))
((eval (read) env-to-use) ht)
((eval (read)) ht)
))))
(set! result (conc "#{(" cmdtype ") " cmd "}"))))
(case cmdsym
((system shell scheme)
(let ((delta (- (current-seconds) start-time)))
(if (> delta 2)
(debug:print-info 0 *default-log-port* "for line \"" l "\"\n command: " cmd " took " delta " seconds to run with output:\n " result)
(debug:print-info 9 *default-log-port* "for line \"" l "\"\n command: " cmd " took " delta " seconds to run with output:\n " result)))))
|
| ︙ | | |
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
|
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
|
-
+
|
(let ((field-names (if ht (common:get-fields ht) '()))
(target (or (getenv "MT_TARGET")(args:get-arg "-reqtarg")(args:get-arg "-target"))))
(debug:print-info 9 *default-log-port* "set-fields with field-names=" field-names " target=" target " curr-section=" curr-section " next-section=" next-section " path=" path " ht=" ht)
(if (not (null? field-names))(keys:target-set-args field-names target #f))))))
(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))))
(configf: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))))
;;======================================================================
;; Non destructive writing of config file
;;======================================================================
|
| ︙ | | |