31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
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:lookup
configf:lookup-number
configf:map-all-hier-alist
configf:read-alist
configf:read-config
configf:read-refdb
configf:section-var-set!
|
>
|
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
|
(let ((res (assoc var sectdat)))
(if res ;; (and match (list? match)(> (length match) 1))
(cadr res)
#f))
))
#f))
(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))
|
>
>
>
|
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
|
(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))
(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
|
|
<
|
<
|
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 (configf:lookup ht-in "" "toppath"))
(configf:set-section-var ht-in "" "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
|
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
|
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\"))))
((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.")))))
|
<
|
|
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))))
((mtrah) `(noeval-needed ,(configf:lookup ht "" "toppath")))
((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.")))))
|
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
|
(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"))))
(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
|
|
|
|
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 #!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
|
(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)))
(if (file-exists? fname) ;; now verify it is readable
(if (configf:read-alist fname)
#t ;; data is good.
(begin
(handle-exceptions
exn
(begin
|
|
|
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
|