| ︙ | | | ︙ | |
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
70
|
(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 (config: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
(config:assoc-safe-add
(hash-table-ref/default cfgdat section-name '())
var value metadata: metadata)))
(define (config:eval-string-in-environment str)
;; (if (or (string-null? str)
;; (equal? "!" (substring str 0 1))) ;; null string or starts with ! are preserved but NOT set in the environment
str
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment, exn=" exn)
|
|
|
|
|
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
70
|
(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)))
(define (configf:eval-string-in-environment str)
;; (if (or (string-null? str)
;; (equal? "!" (substring str 0 1))) ;; null string or starts with ! are preserved but NOT set in the environment
str
(handle-exceptions
exn
(begin
(debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment, exn=" exn)
|
| ︙ | | | ︙ | |
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
(if (and (not same-section) rx-match)
(for-each
(lambda (bundle)
;; (print "bundle: " bundle)
(let ((key (car bundle))
(val (cadr bundle))
(meta (if (> (length bundle) 2)(caddr bundle) #f)))
(hash-table-set! ht section (config:assoc-safe-add (hash-table-ref ht section) key val metadata: meta))))
vars)))))
(hash-table-keys ht))))
ht)
;; read a config file, returns hash table of alists
;; read a config file, returns hash table of alists
|
|
|
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
(if (and (not same-section) rx-match)
(for-each
(lambda (bundle)
;; (print "bundle: " bundle)
(let ((key (car bundle))
(val (cadr bundle))
(meta (if (> (length bundle) 2)(caddr bundle) #f)))
(hash-table-set! ht section (configf:assoc-safe-add (hash-table-ref ht section) key val metadata: meta))))
vars)))))
(hash-table-keys ht))))
ht)
;; read a config file, returns hash table of alists
;; read a config file, returns hash table of alists
|
| ︙ | | | ︙ | |
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
|
(if (> delta 2)
(debug:print-info 0 *default-log-port* "for line \"" inl "\"\n command: " cmd " took " delta " seconds to run with output:\n " res)
(debug:print-info 9 *default-log-port* "for line \"" inl "\"\n command: " cmd " took " delta " seconds to run with output:\n " res))
(if (null? res)
""
(string-intersperse res " "))))))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist
key
(case (calc-allow-system allow-system curr-section-name sections)
((return-procs) val-proc)
((return-string) cmd)
(else (val-proc)))
metadata: metapath))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(loop (configf:read-line inp res
(calc-allow-system allow-system curr-section-name sections)
settings)
curr-section-name #f #f)))
(configf:key-no-val ( x key val)
(let* ((alist (hash-table-ref/default res curr-section-name '()))
(fval (or (if (string? val) val #f) ""))) ;; fval should be either "" or " " (one or more spaces)
(debug:print 10 *default-log-port* " setting: [" curr-section-name "] " key " = #t")
(safe-setenv key fval)
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key fval metadata: metapath))
(loop (configf:read-line inp res
(calc-allow-system allow-system curr-section-name sections)
settings)
curr-section-name key #f)))
(configf:key-val-pr ( x key unk1 val unk2 )
(let* ((alist (hash-table-ref/default res curr-section-name '()))
(envar (and environ-patt
(string-search (regexp environ-patt) curr-section-name) ;; does the section match the envionpatt?
(and (not (string-null? key))
(not (equal? "!" (substring key 0 1)))) ;; ! as leading character is a signature to NOT export to the environment
;; (string-match "^.*:.*:.*$" key) ;; ;; something:something:something reserved for triggers in runconfigs
))
(realval (if envar
(config:eval-string-in-environment val)
val)))
(debug:print-info 6 *default-log-port* "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
(if envar (safe-setenv key realval))
(debug:print 10 *default-log-port* " setting: [" curr-section-name "] " key " = " val)
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key realval metadata: metapath))
(loop (configf:read-line inp res
(calc-allow-system allow-system curr-section-name sections) settings)
curr-section-name key #f)))
;; if a continued line
(configf:cont-ln-rx ( x whsp val )
(let ((alist (hash-table-ref/default res curr-section-name '())))
(if var-flag ;; if set to a string then we have a continued var
(let ((newval (conc
(configf:lookup res curr-section-name var-flag) "\n"
;; trim lead from the incoming whsp to support some indenting.
(if lead
(string-substitute (regexp lead) "" whsp)
"")
val)))
;; (print "val: " val "\nnewval: \"" newval "\"\nvarflag: " var-flag)
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist var-flag newval metadata: metapath))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name var-flag (if lead lead whsp)))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))
(else (debug:print-error 0 *default-log-port* "problem parsing " path ",\n \"" inl "\"")
(set! var-flag #f)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))
) ;; end loop
)))
|
|
|
|
|
|
|
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
|
(if (> delta 2)
(debug:print-info 0 *default-log-port* "for line \"" inl "\"\n command: " cmd " took " delta " seconds to run with output:\n " res)
(debug:print-info 9 *default-log-port* "for line \"" inl "\"\n command: " cmd " took " delta " seconds to run with output:\n " res))
(if (null? res)
""
(string-intersperse res " "))))))
(hash-table-set! res curr-section-name
(configf:assoc-safe-add alist
key
(case (calc-allow-system allow-system curr-section-name sections)
((return-procs) val-proc)
((return-string) cmd)
(else (val-proc)))
metadata: metapath))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(loop (configf:read-line inp res
(calc-allow-system allow-system curr-section-name sections)
settings)
curr-section-name #f #f)))
(configf:key-no-val ( x key val)
(let* ((alist (hash-table-ref/default res curr-section-name '()))
(fval (or (if (string? val) val #f) ""))) ;; fval should be either "" or " " (one or more spaces)
(debug:print 10 *default-log-port* " setting: [" curr-section-name "] " key " = #t")
(safe-setenv key fval)
(hash-table-set! res curr-section-name
(configf:assoc-safe-add alist key fval metadata: metapath))
(loop (configf:read-line inp res
(calc-allow-system allow-system curr-section-name sections)
settings)
curr-section-name key #f)))
(configf:key-val-pr ( x key unk1 val unk2 )
(let* ((alist (hash-table-ref/default res curr-section-name '()))
(envar (and environ-patt
(string-search (regexp environ-patt) curr-section-name) ;; does the section match the envionpatt?
(and (not (string-null? key))
(not (equal? "!" (substring key 0 1)))) ;; ! as leading character is a signature to NOT export to the environment
;; (string-match "^.*:.*:.*$" key) ;; ;; something:something:something reserved for triggers in runconfigs
))
(realval (if envar
(configf:eval-string-in-environment val)
val)))
(debug:print-info 6 *default-log-port* "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
(if envar (safe-setenv key realval))
(debug:print 10 *default-log-port* " setting: [" curr-section-name "] " key " = " val)
(hash-table-set! res curr-section-name
(configf:assoc-safe-add alist key realval metadata: metapath))
(loop (configf:read-line inp res
(calc-allow-system allow-system curr-section-name sections) settings)
curr-section-name key #f)))
;; if a continued line
(configf:cont-ln-rx ( x whsp val )
(let ((alist (hash-table-ref/default res curr-section-name '())))
(if var-flag ;; if set to a string then we have a continued var
(let ((newval (conc
(configf:lookup res curr-section-name var-flag) "\n"
;; trim lead from the incoming whsp to support some indenting.
(if lead
(string-substitute (regexp lead) "" whsp)
"")
val)))
;; (print "val: " val "\nnewval: \"" newval "\"\nvarflag: " var-flag)
(hash-table-set! res curr-section-name
(configf:assoc-safe-add alist var-flag newval metadata: metapath))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name var-flag (if lead lead whsp)))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))
(else (debug:print-error 0 *default-log-port* "problem parsing " path ",\n \"" inl "\"")
(set! var-flag #f)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))
) ;; end loop
)))
|
| ︙ | | | ︙ | |
522
523
524
525
526
527
528
529
530
531
532
533
534
535
|
;; 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 config-lookup configf:lookup)
(define configf:read-file read-config)
;; 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))
|
>
|
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
|
;; 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)
(define configf:read-file read-config)
;; 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))
|
| ︙ | | | ︙ | |
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
|
(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
(config:assoc-safe-add sectdat var val))))
;;(append (filter (lambda (x)(not (assoc var sectdat))) sectdat)
;; (list var val))))
|
|
>
|
|
|
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
|
(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))))
(define (setup)
(let* ((configf (find-config "megatest.config"))
(config (if configf (read-config configf #f #t) #f)))
(if config
(setenv "RUN_AREA_HOME" (pathname-directory configf)))
config))
|
| ︙ | | | ︙ | |