| ︙ | | |
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
+
|
common:with-env-vars
configf:config->ini
configf:alist->config
configf:assoc-safe-add
configf:config->alist
configf:find-and-read-config
configf:get-section
configf:get-sections
configf:lookup
configf:lookup-number
configf:map-all-hier-alist
configf:read-alist
configf:read-config
configf:read-refdb
configf:section-var-set!
|
| ︙ | | |
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
+
+
+
|
(let ((res (assoc var sectdat)))
(if res ;; (and match (list? match)(> (length match) 1))
(cadr res)
#f))
))
#f))
(define (configf:get-sections cfgdat)
(filter string? (hash-table-keys cfgdat)))
(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))
|
| ︙ | | |
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
|
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
|
-
+
-
-
+
-
|
(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)
(make-hash-table)
ht)))
(if (not (hash-table-exists? ht-in 'metadata))
(if (not (configf:lookup ht-in "" "toppath"))
(begin
(hash-table-set! ht-in 'metadata (make-hash-table))
(hash-table-set! (hash-table-ref ht-in 'metadata) 'toppath path)))
|
| ︙ | | |
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
|
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
|
-
-
+
|
cmd ")"))
(case cmdsym
((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) `(noeval-needed ,(hash-table-ref (hash-table-ref ht 'metadata) 'toppath))) ;; (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))))
|
| ︙ | | |
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
|
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
|
-
-
+
+
|
(loop (conc prestr result poststr)))
res))
res)))
;;======================================================================
;; Lookup a value in runconfigs based on -reqtarg or -target
;;
(define (runconfigs-get config var)
(let ((targ (mytarget) #;(common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
(define (runconfigs-get config var #!optional (target #f))
(let ((targ (or target (mytarget)))) ;; (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
(if targ
(or (configf:lookup config targ var)
(configf:lookup config "default" var))
(configf:lookup config "default" var))))
;; pathenvvar will set the named var to the path of the config
|
| ︙ | | |
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
|
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
|
-
+
|
(debug:print 0 *default-log-port* "INFO: NEED LOCKING ADDED HERE " fname)
(let* ((dat (configf:config->alist cdat))
(res
(begin
(with-output-to-file fname ;; first write out the file
(lambda ()
(pp dat)))
;; I don't like this. It makes write-alist opaque and complicated. -mrw-
(if (file-exists? fname) ;; now verify it is readable
(if (configf:read-alist fname)
#t ;; data is good.
(begin
(handle-exceptions
exn
(begin
|
| ︙ | | |