Overview
Comment: | Added rmt:get-servers-info, removed remote logging, misc other tweaks. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v2.0001 |
Files: | files | file ages | folders |
SHA1: |
52c2bf27f4620c1b56fbc97d64fd5840 |
User & Date: | matt on 2022-01-30 20:12:23 |
Other Links: | branch diff | manifest | tags |
Context
2022-02-01
| ||
15:28 | added (mytarget targ) parameter setting when we have a target argument check-in: 14210eec84 user: mmgraham tags: v2.0001 | |
2022-01-30
| ||
20:12 | Added rmt:get-servers-info, removed remote logging, misc other tweaks. check-in: 52c2bf27f4 user: matt tags: v2.0001 | |
2022-01-27
| ||
18:46 | Removed debug message check-in: 5c0b2c5dd4 user: mrwellan tags: v2.0001 | |
Changes
Modified dashboard.scm from [eeb859c6bf] to [78bde266eb].
︙ | ︙ | |||
3247 3248 3249 3250 3251 3252 3253 | (zeroth-point (conc "SELECT " timef "," varfn "," valfn " FROM " tablen " WHERE " varfn "='" fieldname "' AND " timef " < " tstart " LIMIT 1"))) (hash-table-set! res-ht fieldname ;; (fetch-rows (sql db qrystr))))) (reverse (sqlite3:fold-row (lambda (res t var val) (cons (vector t var val) res)) '() db all-dat-qrystr))) | | < < | > > | 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 | (zeroth-point (conc "SELECT " timef "," varfn "," valfn " FROM " tablen " WHERE " varfn "='" fieldname "' AND " timef " < " tstart " LIMIT 1"))) (hash-table-set! res-ht fieldname ;; (fetch-rows (sql db qrystr))))) (reverse (sqlite3:fold-row (lambda (res t var val) (cons (vector t var val) res)) '() db all-dat-qrystr))) (let ((zeropt (condition-case (sqlite3:first-row db all-dat-qrystr) (exn (busy)(db:generic-error-printout exn "ERROR: database " dbdef " is locked. Try copying to another location, remove original and copy back."))))) (if zeropt ;; NOTE: Add zeropt to the beginning of the list as the list was reversed above. (hash-table-set! res-ht fieldname (cons (apply vector tstart (cdr zeropt)) (hash-table-ref/default res-ht fieldname '()))))))) fields) |
︙ | ︙ |
Modified dbmod.scm from [351701514f] to [8c09a0af38].
︙ | ︙ | |||
1053 1054 1055 1056 1057 1058 1059 | (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) (numrecs (make-hash-table)) (start-time (current-milliseconds)) (tot-count 0)) (for-each ;; table (lambda (tabledat) | > | > > > | 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 | (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) (numrecs (make-hash-table)) (start-time (current-milliseconds)) (tot-count 0)) (for-each ;; table (lambda (tabledat) (condition-case (db:sync-one-table fromdb todb tabledat last-update numrecs) ;; if db is busy, take a break and try one more time (exn (busy)(thread-sleep! 0.5) (db:sync-one-table fromdb todb tabledat last-update numrecs)))) tbls) (let* ((runtime (- (current-milliseconds) start-time)) (should-print (or (debug:debug-mode 12) (common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate. (if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms")) (for-each |
︙ | ︙ | |||
2412 2413 2414 2415 2416 2417 2418 | ;; look up values in a header/data structure (define (db:get-value-by-header row header field) (if (or (null? header) (not row)) #f (let loop ((hed (car header)) (tal (cdr header)) (n 0)) | | | > | < | | | < | 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 | ;; look up values in a header/data structure (define (db:get-value-by-header row header field) (if (or (null? header) (not row)) #f (let loop ((hed (car header)) (tal (cdr header)) (n 0)) (if (equal? hed field);;(condition-case (vector-ref #(1 2 3) 3)(exn (bounds)(print "out of bounds"))) (condition-case (vector-ref row n) (exn (bounds) (debug:print 0 *default-log-port* "WARNING: attempt to read non-existant field, row=" row " header=" header " field=" field ", exn=" exn) #f)) (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1))))))) ;; Accessors for the header/data structure ;; get rows and header from (define (db:get-header vec)(vector-ref vec 0)) (define (db:get-rows vec)(vector-ref vec 1)) |
︙ | ︙ | |||
4845 4846 4847 4848 4849 4850 4851 | (begin (handle-exceptions exn (begin (debug:print 0 *default-log-port* "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl ", exn=" exn) res) | | < < < | 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 | (begin (handle-exceptions exn (begin (debug:print 0 *default-log-port* "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl ", exn=" exn) res) (string-substitute patt repl res))) (begin (debug:print 0 *default-log-port* "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl) res)))) (if (null? tal) newr (loop (car tal)(cdr tal) newr))))))) |
︙ | ︙ |
Modified debugprint.scm from [d12dfb8eae] to [03faa79da0].
︙ | ︙ | |||
124 125 126 127 128 129 130 | (define (debug:print n e . params) (if (debug:debug-mode n) (with-output-to-port (or e (current-error-port)) (lambda () ;; (if *logging* ;; (db:log-event (apply conc params)) (apply print (debug:timestamp) params) | | | | | | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 | (define (debug:print n e . params) (if (debug:debug-mode n) (with-output-to-port (or e (current-error-port)) (lambda () ;; (if *logging* ;; (db:log-event (apply conc params)) (apply print (debug:timestamp) params) ;; (debug:handle-remote-logging params) ))) #t ;; only here to make remote stuff happy. It'd be nice to fix that ... ) (define (debug:print-error n e . params) ;; normal print (if (debug:debug-mode n) (with-output-to-port (if (port? e) e (current-error-port)) (lambda () (apply print "ERROR: " (debug:timestamp) params) ;; (debug:handle-remote-logging (cons "ERROR: " params)) ))) ;; pass important messages to stderr (if (and (eq? n 0)(not (eq? e (current-error-port)))) (with-output-to-port (current-error-port) (lambda () (apply print "ERROR: " (debug:timestamp) params) )))) (define (debug:print-info n e . params) (if (debug:debug-mode n) (with-output-to-port (if (port? e) e (current-error-port)) (lambda () (apply print "INFO: (" n ") "(debug:timestamp) params) ;; res) ;; (debug:handle-remote-logging (cons "INFO: " params)) )))) (define (debug:print-warn n e . params) (if (debug:debug-mode n) (with-output-to-port (if (port? e) e (current-error-port)) (lambda () (apply print "WARN: (" n ") " (debug:timestamp) params) ;; res) ;; (debug:handle-remote-logging (cons "WARN: " params)) )))) ) |
Modified rmtmod.scm from [1b0587b637] to [6232f78f49].
︙ | ︙ | |||
1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 | #f (conc "http://" (car hostport) ":" (cadr hostport)))) ;;====================================================================== ;; S E R V E R ;; ====================================================================== ;; (define (http-get-function fnkey) ;; (hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet"))) ;;====================================================================== ;; C L I E N T S ;;====================================================================== | > > > | 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 | #f (conc "http://" (car hostport) ":" (cadr hostport)))) ;;====================================================================== ;; S E R V E R ;; ====================================================================== (define (rmt:get-servers-info apath) (rmt:send-receive 'get-servers-info #f `(,apath))) ;; (define (http-get-function fnkey) ;; (hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet"))) ;;====================================================================== ;; C L I E N T S ;;====================================================================== |
︙ | ︙ |