22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
+
+
+
+
-
+
+
|
;; Config file handling
;;======================================================================
(use regex regex-case matchable) ;; directory-utils)
(declare (unit configf))
(declare (uses process))
(declare (uses env))
(declare (uses commonmod))
(import commonmod)
(declare (uses keys))
(declare (uses configfmod))
(import configfmod)
(include "common_records.scm")
;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
(if toppath
(let ((cfname (conc toppath "/" configname)))
|
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
-
-
-
-
-
-
-
-
-
-
-
-
|
(if (common:file-exists? fullpath)
(list path fullpath configname)
(let ((remcwd (take dir (- (length dir) 1))))
(if (null? remcwd)
(list #f #f #f) ;; #f #f)
(loop remcwd)))))))))
(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))
(hash-table-set! cfgdat section-name
(configf:assoc-safe-add
(hash-table-ref/default cfgdat section-name '())
var value metadata: metadata)))
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
-
+
|
((mtrah) (conc "(lambda (ht)"
" (let ((extra \"" cmd "\"))"
" (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
" (if (string-null? extra) \"\" \"/\")"
" extra)))"))
((get g)
(match (string-split cmd)
((sect var)(conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))"))
((sect var)(conc "(lambda (ht)(configfmod#configf:lookup ht \"" sect "\" \"" var "\"))"))
(else
(debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.")
"(lambda (ht) #f)")))
((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
;; ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
;; (print "fullcmd=" fullcmd)
|
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
|
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
|
(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))))
(if toppath (change-directory curr-dir))
(list configdat toppath configfile fname))))
;;======================================================================
;; lookup and manipulation routines
;;======================================================================
;; (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))
;; (hash-table-set! cfgdat section-name
;; (configf:assoc-safe-add
;; (hash-table-ref/default cfgdat section-name '())
;; var value metadata: metadata)))
;;
(define (configf:lookup cfgdat section var)
(if (hash-table? cfgdat)
(let ((sectdat (hash-table-ref/default cfgdat section '())))
(if (null? sectdat)
#f
(let ((match (assoc var sectdat)))
(if match ;; (and match (list? match)(> (length match) 1))
(cadr match)
#f))
))
#f))
;; use to have definitive setting:
;; [foo]
;; var yes
;;
;; (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))
;; (define (configf:lookup cfgdat section var)
;; (if (hash-table? cfgdat)
;; (let ((sectdat (hash-table-ref/default cfgdat section '())))
;; (if (null? sectdat)
;; #f
;; (let ((match (assoc var sectdat)))
;; (if match ;; (and match (list? match)(> (length match) 1))
;; (cadr match)
;; #f))
;; ))
;; #f))
;;
;; ;; use to have definitive setting:
;; ;; [foo]
;; ;; var yes
;; ;;
;; ;; (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)
;; 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 *configdat* section varname))
(res (if val
(string->number (string-substitute "\\s+" "" val #t))
#f)))
(cond
(res res)
(val (debug:print 0 *default-log-port* "ERROR: no number found for [" section "], " varname ", got: " val))
(else default))))
(define (configf:section-vars cfgdat section)
(let ((sectdat (hash-table-ref/default cfgdat section '())))
(if (null? sectdat)
'()
(map car sectdat))))
(define (configf:get-section cfgdat section)
(hash-table-ref/default cfgdat section '()))
(define (configf:set-section-var cfgdat section var val)
(let ((sectdat (configf:get-section cfgdat section)))
(hash-table-set! cfgdat section
(configf:assoc-safe-add sectdat var val))))
;; ;; 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 *configdat* section varname))
;; (res (if val
;; (string->number (string-substitute "\\s+" "" val #t))
;; #f)))
;; (cond
;; (res res)
;; (val (debug:print 0 *default-log-port* "ERROR: no number found for [" section "], " varname ", got: " val))
;; (else default))))
;;
;; (define (configf:section-vars cfgdat section)
;; (let ((sectdat (hash-table-ref/default cfgdat section '())))
;; (if (null? sectdat)
;; '()
;; (map car sectdat))))
;;
;; (define (configf:get-section cfgdat section)
;; (hash-table-ref/default cfgdat section '()))
;;
;; (define (configf:set-section-var cfgdat section var val)
;; (let ((sectdat (configf:get-section cfgdat section)))
;; (hash-table-set! cfgdat section
;; (configf:assoc-safe-add sectdat var val))))
;;
;;======================================================================
;;(append (filter (lambda (x)(not (assoc var sectdat))) sectdat)
;; (list var val))))
|