Overview
Comment: | Back anotated several minor fixes from the module work in configf.scm |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-merge-fixes |
Files: | files | file ages | folders |
SHA1: |
dc43b3418e799d4a28a530781b89111b |
User & Date: | matt on 2019-11-04 20:09:09 |
Other Links: | branch diff | manifest | tags |
Context
2019-11-04
| ||
20:47 | Applied more fixes from modulization work check-in: e6e04b8c79 user: matt tags: v1.65-merge-fixes | |
20:09 | Back anotated several minor fixes from the module work in configf.scm check-in: dc43b3418e user: matt tags: v1.65-merge-fixes | |
2019-10-24
| ||
11:16 | added notification hook for feedback check-in: b3fbd7024b user: pjhatwal tags: v1.65 | |
Changes
Modified configf.scm from [c596e07f23] to [7ddf02a0ed].
︙ | ︙ | |||
119 120 121 122 123 124 125 | " (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))" " (if (string-null? extra) \"\" \"/\")" " extra)))")) ((get g) (let* ((parts (string-split cmd)) (sect (car parts)) (var (cadr parts))) | | | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | " (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))" " (if (string-null? extra) \"\" \"/\")" " extra)))")) ((get g) (let* ((parts (string-split cmd)) (sect (car parts)) (var (cadr parts))) (conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))"))) ((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) (handle-exceptions exn (begin |
︙ | ︙ | |||
461 462 463 464 465 466 467 | (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 | | | 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 | (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 |
︙ | ︙ | |||
496 497 498 499 500 501 502 | (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)))) | | | | 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 | (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)))) (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 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)) (let* ((val (configf:lookup *configdat* section varname)) |
︙ | ︙ | |||
632 633 634 635 636 637 638 | (fdat (configf:file->list fname)) (refdat (make-hash-table)) (sechash (make-hash-table)) ;; current section hash, init with hash for "default" section (new #f) ;; put the line to be used in new, if it is to be deleted the set new to #f (secname #f)) ;; step 2: Flatten multiline entries | | | | | 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 | (fdat (configf:file->list fname)) (refdat (make-hash-table)) (sechash (make-hash-table)) ;; current section hash, init with hash for "default" section (new #f) ;; put the line to be used in new, if it is to be deleted the set new to #f (secname #f)) ;; step 2: Flatten multiline entries (if (not (null? fdat))(set! fdat (configf:compress-multi-lines fdat))) ;; step 3: Modify values per contents of "indat" and remove absent values (if (not (null? fdat)) (let loop ((hed (car fdat)) (tal (cadr fdat)) (res '()) (lnum 0)) (regex-case hed (configf:comment-rx _ (set! res (append res (list hed)))) ;; (loop (read-line inp) curr-section-name #f #f)) (configf:blank-l-rx _ (set! res (append res (list hed)))) ;; (loop (read-line inp) curr-section-name #f #f)) (configf:section-rx ( x section-name ) (let ((section-hash (hash-table-ref/default refdat section-name #f))) (if (not section-hash) (let ((newhash (make-hash-table))) (hash-table-set! refdat section-name newhash) ;; was refhash - not sure that refdat is correct here (set! sechash newhash)) (set! sechash section-hash)) (set! new hed) ;; will append this at the bottom of the loop (set! secname section-name) )) ;; No need to process key cmd, let it fall though to key val (configf:key-val-pr ( x key val ) (let ((newval (configf:lookup indat secname key))) ;; was sec, bug or correct? ;; can handle newval == #f here => that means key is removed (cond ((equal? newval val) (set! res (append res (list hed)))) ((not newval) ;; key has been removed (set! new #f)) ((not (equal? newval val)) |
︙ | ︙ | |||
681 682 683 684 685 686 687 | ;; step 4: Append new values to the section (for-each (lambda (section) (let ((sdat '()) ;; append needed bits here (svars (configf:section-vars indat section))) (for-each (lambda (var) | | | | 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 | ;; step 4: Append new values to the section (for-each (lambda (section) (let ((sdat '()) ;; append needed bits here (svars (configf:section-vars indat section))) (for-each (lambda (var) (let ((val (configf:lookup refdat section var))) (if (not val) ;; this one is new (begin (if (null? sdat)(set! sdat (list (conc "[" section "]")))) (set! sdat (append sdat (list (conc var " " val)))))))) svars) (set! fdat (append fdat sdat)))) (delete-duplicates (append required-sections (hash-table-keys indat)))) ;; step 5: Write out new file (with-output-to-file fname (lambda () (for-each (lambda (line) (print line)) |
︙ | ︙ |