319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
|
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
|
-
+
|
(rxstr (if (string-contains section-name "%")
(string-substitute (regexp "%") ".*" section-name)
(string-substitute (regexp "^/(.*)/$") "\\1" section-name)))
(rx (regexp rxstr)))
;; (print "\nsection-name: " section-name " rxstr: " rxstr)
(for-each
(lambda (section)
(if section
(if (string? section)
(let ((same-section (string=? section-name section))
(rx-match (string-match rx section)))
;; (print "section: " section " vars: " vars " same-section: " same-section " rx-match: " rx-match)
(if (and (not same-section) rx-match)
(for-each
(lambda (bundle)
;; (print "bundle: " bundle)
|
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
|
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
|
-
-
-
+
+
+
+
+
+
-
+
+
+
+
+
+
+
|
;; '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 (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))
(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* "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)))
(inp (if (string? path)
(open-input-file path)
path)) ;; we can be handed a port
(res (let ((ht-in (if (not ht)
(res (if (not ht)(make-hash-table) 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
(string-match "/.*/" curr-section-name))) ;; regex
|
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
|
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
|
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
+
-
-
+
+
+
+
-
+
|
;; convert hierarchial list to ini format
;;
(define (configf:config->ini data)
(map
(lambda (section)
(let ((section-name (car section))
(section-dat (cdr section)))
(if (string? section-name)
(begin
(print "\n[" section-name "]")
(map (lambda (dat-pair)
(let* ((var (car dat-pair))
(val (cadr dat-pair))
(fname (if (> (length dat-pair) 2)(caddr dat-pair) #f)))
(if fname (print "# " var "=>" fname))
(print var " " val)))
section-dat))) ;; (print "section-dat: " section-dat))
(define configf:std-imports "(import big-chicken configfmod commonmod rmtmod)")
(define configf:std-imports "(import big-chicken configfmod commonmod rmtmod (prefix mtargs args:))")
(define (configf:process-one matchdat l ht allow-system env-to-use linenum)
(let* ((prestr (list-ref matchdat 1))
(cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
(cmd (list-ref matchdat 3))
(quotedcmd (conc "\""cmd"\""))
(poststr (list-ref matchdat 4))
(result #f)
(start-time (current-seconds))
(cmdsym (string->symbol cmdtype))
(fullcmd
(if (member cmdsym '(scheme scm))
`(eval-needed
,(conc "(lambda (ht)"
configf:std-imports
cmd ")"))
(case cmdsym
((system) `(noeval-needed ,(conc (configf:system ht quotedcmd))))
((shell sh) `(noeval-needed ,(conc (string-translate (shell quotedcmd) "\n" " "))))
((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) (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))))
((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.")))))
|