174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
+
+
-
+
|
;; read a config file, returns hash table of alists
;; read a config file, returns hash table of alists
;; adds to ht if given (must be #f otherwise)
;; 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)
;;
(define (read-config path ht allow-system #!key (environ-patt #f)(curr-section #f)(sections #f)(settings (make-hash-table))(keep-filenames #f))
(define (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 '()))
(debug:print-info 5 "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections " pwd: " (current-directory))
(debug:print 9 "START: " path)
(if (not (file-exists? path))
(begin
(debug:print-info 1 "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))
|
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
|
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames)
;; (pop-directory)
(loop (configf:read-line inp res allow-system settings) curr-section-name #f #f))
(begin
(debug:print '(2 9) "INFO: include file " include-file " not found (called from " path ")")
(debug:print 2 " " full-conf)
(loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)))))
(configf:section-rx ( x section-name ) (loop (configf:read-line inp res allow-system settings)
;; if we have the sections list then force all settings into "" and delete it later?
(if (or (not sections)
(member section-name sections))
section-name "") ;; stick everything into ""
#f #f))
(configf:section-rx ( x section-name ) (begin
;; call post-section-procs
(for-each
(lambda (dat)
(let ((patt (car dat))
(proc (cdr dat)))
(if (string-match patt curr-section-name)
(proc curr-section-name section-name ht path))))
post-section-procs)
(loop (configf:read-line inp res allow-system settings)
;; if we have the sections list then force all settings into "" and delete it later?
(if (or (not sections)
(member section-name sections))
section-name "") ;; stick everything into ""
#f #f)))
(configf:key-sys-pr ( x key cmd ) (if allow-system
(let ((alist (hash-table-ref/default res curr-section-name '()))
(val-proc (lambda ()
(let* ((start-time (current-seconds))
(cmdres (cmd-run->list cmd))
(delta (- (current-seconds) start-time))
(status (cadr cmdres))
|
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
|
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
|
-
+
+
+
+
+
-
+
+
|
(loop (configf:read-line inp res allow-system settings) curr-section-name #f #f))))))))
;; pathenvvar will set the named var to the path of the config
(define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f))
(let* ((curr-dir (current-directory))
(configinfo (find-config fname toppath: given-toppath))
(toppath (car configinfo))
(configfile (cadr configinfo)))
(configfile (cadr configinfo))
(set-fields (lambda (curr-section next-section ht path)
(let ((field-names (keys:config-get-fields confdat))
(target (or (getenv "MT_TARGET")(args:get-arg "-reqtarg")(args:get-arg "-target"))))
(keys:target-set-args keys 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) #f))) ;; (make-hash-table))))
(let ((configdat (if configfile
(read-config configfile #f #t environ-patt: environ-patt (list (cons "^fields$" set-fields)) #f))))
(if toppath (change-directory curr-dir))
(list configdat toppath configfile fname))))
(define (config-lookup cfgdat section var)
(if (hash-table? cfgdat)
(let ((sectdat (hash-table-ref/default cfgdat section '())))
(if (null? sectdat)
|