Overview
Comment: | cleanup some duplicated functions |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6569-multi-db-wip |
Files: | files | file ages | folders |
SHA1: |
a1bb05ec001eaff5a508ee25fa00d370 |
User & Date: | matt on 2021-02-14 19:39:37 |
Other Links: | branch diff | manifest | tags |
Context
2021-02-14
| ||
20:26 | Minor cleanup check-in: d6e2d2990e user: matt tags: v1.6569-multi-db-wip (unpublished) | |
19:39 | cleanup some duplicated functions check-in: a1bb05ec00 user: matt tags: v1.6569-multi-db-wip (unpublished) | |
2021-02-13
| ||
23:02 | still trying check-in: e2ce43a8fe user: matt tags: v1.6569-multi-db-wip (unpublished) | |
Changes
Modified Makefile from [02e947d86c] to [5e0bb65eca].
︙ | ︙ | |||
26 27 28 29 30 31 32 | process.scm runs.scm tasks.scm tests.scm genexample.scm \ http-transport.scm filedb.scm tdb.scm client.scm mt.scm \ ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm \ subrun.scm portlogger.scm archive.scm env.scm \ diff-report.scm cgisetup/models/pgdb.scm # module source files | | | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | process.scm runs.scm tasks.scm tests.scm genexample.scm \ http-transport.scm filedb.scm tdb.scm client.scm mt.scm \ ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm \ subrun.scm portlogger.scm archive.scm env.scm \ diff-report.scm cgisetup/models/pgdb.scm # module source files MSRCFILES = dbmod.scm servermod.scm apimod.scm commonmod.scm rmtmod.scm ods.scm configfmod.scm MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o)) MOIMPFILES = $(MSRCFILES:%.scm=%.import.o) # ftail.scm rmtmod.scm commonmod.scm removed # MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \ # mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm \ # rmtmod.scm apimod.scm |
︙ | ︙ |
Modified commonmod.scm from [872aa57f90] to [13fee5dc62].
︙ | ︙ | |||
169 170 171 172 173 174 175 | val-list)) '()))) ;;====================================================================== ;; testsuite and area utilites ;;====================================================================== | < < < < < < < < < < < < < < < | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 | val-list)) '()))) ;;====================================================================== ;; testsuite and area utilites ;;====================================================================== (define (get-area-path-signature toppath #!optional (short #f)) (let ((res (message-digest-string (md5-primitive) toppath))) (if short (substring res 0 4) res))) ;; need generic find-record-with-var-nmatching-val ;; (define (path->area-record cfgdat path) (let* ((areadat (get-cfg-areas cfgdat)) (all (filter (lambda (x) (let* ((keyvals (cdr x)) (pth (alist-ref 'path keyvals))) |
︙ | ︙ | |||
2565 2566 2567 2568 2569 2570 2571 | (output (with-input-from-pipe cmd read-lines))) (debug:print 2 *default-log-port* "Running " cmd " received " output) (if (eq? (length output) 0) #f #t)) #t)) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 | (output (with-input-from-pipe cmd read-lines))) (debug:print 2 *default-log-port* "Running " cmd " received " output) (if (eq? (length output) 0) #f #t)) #t)) ;; ;;====================================================================== ;; ;; N A N O M S G C L I E N T ;; ;;====================================================================== ;; ;; ;; ;; (define (common:send-dboard-main-changed) |
︙ | ︙ | |||
3145 3146 3147 3148 3149 3150 3151 | (if (eof-object? inl) (reverse res) (let ((nums (map string->number (string-split-fields "\\d+" inl)))) (loop (read-line) (append res nums)))))))) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 | (if (eof-object? inl) (reverse res) (let ((nums (map string->number (string-split-fields "\\d+" inl)))) (loop (read-line) (append res nums)))))))) ;;====================================================================== ;; stuff from tests.scm ;;====================================================================== ;; given a list of itemmaps (testname . map), return the first match ;; |
︙ | ︙ |
Modified configf.scm from [71c7d9a4ec] to [bb55db8e45].
︙ | ︙ | |||
26 27 28 29 30 31 32 33 34 35 36 37 38 39 | (declare (unit configf)) (declare (uses process)) (declare (uses env)) (declare (uses keys)) (declare (uses commonmod)) (import commonmod) (include "common_records.scm") ;; return list (path fullpath configname) (define (find-config configname #!key (toppath #f)) (if toppath (let ((cfname (conc toppath "/" configname))) | > > > | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | (declare (unit configf)) (declare (uses process)) (declare (uses env)) (declare (uses keys)) (declare (uses commonmod)) (import commonmod) (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))) |
︙ | ︙ | |||
47 48 49 50 51 52 53 | (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))))))))) | | | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | (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: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) |
︙ | ︙ | |||
230 231 232 233 234 235 236 | (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))) | | | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 | (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 |
︙ | ︙ | |||
408 409 410 411 412 413 414 | (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 | | | | | | | 411 412 413 414 415 416 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 | (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 ))) |
︙ | ︙ | |||
496 497 498 499 500 501 502 | (if toppath (change-directory curr-dir)) (list configdat toppath configfile fname)))) ;;====================================================================== ;; lookup and manipulation routines ;;====================================================================== | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 | (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 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)) ;; (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)))) ;; ;;====================================================================== ;; setup ;;====================================================================== (define (setup) (let* ((configf (find-config "megatest.config")) (config (if configf (read-config configf #f #t) #f))) |
︙ | ︙ |
Modified dashboard.scm from [e02aa345cf] to [c21cdd8720].
︙ | ︙ | |||
61 62 63 64 65 66 67 | ;; (declare (uses ods)) ;; (import ods) ;; (declare (uses dbmod)) (import dbmod) ;; (declare (uses dbmod.import)) | | > > > | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 | ;; (declare (uses ods)) ;; (import ods) ;; (declare (uses dbmod)) (import dbmod) ;; (declare (uses dbmod.import)) (declare (uses configfmod)) (import configfmod) (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") (include "task_records.scm") (include "megatest-version.scm") ;; (include "megatest-fossil-hash.scm") (include "vg_records.scm") |
︙ | ︙ |
Modified dbmod.scm from [8c7923fe96] to [c47894a6b4].
︙ | ︙ | |||
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit dbmod)) (declare (uses commonmod)) (declare (uses ods)) (module dbmod * (import commonmod) (import ods) (import scheme chicken data-structures extras ports) (import (prefix base64 base64:) (prefix sqlite3 sqlite3:) csv csv-xml | > > | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit dbmod)) (declare (uses commonmod)) (declare (uses ods)) (declare (uses configfmod)) (module dbmod * (import commonmod) (import ods) (import configfmod) (import scheme chicken data-structures extras ports) (import (prefix base64 base64:) (prefix sqlite3 sqlite3:) csv csv-xml |
︙ | ︙ |
Modified launch.scm from [7ad49f6487] to [20b6dedc14].
︙ | ︙ | |||
36 37 38 39 40 41 42 43 44 45 46 47 48 49 | (declare (uses ezsteps)) (declare (uses commonmod)) (import commonmod) (declare (uses dbmod)) (import dbmod) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "megatest-fossil-hash.scm") ;;====================================================================== | > > > | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | (declare (uses ezsteps)) (declare (uses commonmod)) (import commonmod) (declare (uses dbmod)) (import dbmod) (declare (uses configfmod)) (import configfmod) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "megatest-fossil-hash.scm") ;;====================================================================== |
︙ | ︙ |
Modified mtexec.scm from [6016ee8684] to [582cd76cba].
︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 | (prefix dbi dbi:) ) ;; (declare (uses common)) (declare (uses margs)) (declare (uses configf)) ;; (declare (uses rmt)) ;; (use ducttape-lib) (include "megatest-version.scm") (include "megatest-fossil-hash.scm") ;; (require-library stml) | > > > | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | (prefix dbi dbi:) ) ;; (declare (uses common)) (declare (uses margs)) (declare (uses configf)) ;; (declare (uses rmt)) (declare (uses configfmod)) (import configfmod) ;; (use ducttape-lib) (include "megatest-version.scm") (include "megatest-fossil-hash.scm") ;; (require-library stml) |
︙ | ︙ |
Modified mtut.scm from [5d611c3d90] to [f14475ff21].
︙ | ︙ | |||
31 32 33 34 35 36 37 38 39 40 41 42 43 44 | (declare (uses common)) (declare (uses margs)) (declare (uses configf)) ;; (declare (uses rmt)) (declare (uses commonmod)) (import commonmod) (use ducttape-lib) (include "megatest-fossil-hash.scm") (require-library stml) | > > > | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | (declare (uses common)) (declare (uses margs)) (declare (uses configf)) ;; (declare (uses rmt)) (declare (uses commonmod)) (import commonmod) (declare (uses configfmod)) (import configfmod) (use ducttape-lib) (include "megatest-fossil-hash.scm") (require-library stml) |
︙ | ︙ |