371
372
373
374
375
376
377
378
379
380
381
382
383
384
|
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
|
+
|
'("avg_runtime" #f)
'("avg_disk" #f)
'("tags" #f)
'("jobgroup" #f)))))
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
(define (db:sync-tables tbls fromdb todb . slave-dbs)
(mutex-lock! *db-sync-mutex*)
(cond
((not fromdb) (debug:print 3 "WARNING: db:sync-tables called with fromdb missing") -1)
((not todb) (debug:print 3 "WARNING: db:sync-tables called with todb missing") -2)
((not (sqlite3:database? fromdb))
(debug:print 0 "ERROR: db:sync-tables called with fromdb not a database " fromdb) -3)
((not (sqlite3:database? todb))
(debug:print 0 "ERROR: db:sync-tables called with todb not a database " todb) -4)
|
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
|
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
|
-
+
+
|
(lambda (dat)
(let ((tblname (car dat))
(count (cdr dat)))
(set! tot-count (+ tot-count count))
(if (> count 0)
(debug:print 0 (format #f " ~10a ~5a" tblname count)))))
(sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
tot-count))))
tot-count)))
(mutex-unlock! *db-sync-mutex*))
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
(debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
(if (or *db-write-access*
(not (member proc *db:all-write-procs*)))
(let* ((db (cond
|
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
|
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
|
-
+
|
;;======================================================================
;; M I S C M A N A G E M E N T I T E M S
;;======================================================================
;; A routine to map itempaths using a itemmap
(define (db:compare-itempaths patha pathb itemmap)
(debug:print-info 3 "ITEMMAP is " itemmap)
(debug:print-info 6 "ITEMMAP is " itemmap)
(if itemmap
(let* ((mapparts (string-split itemmap))
(pattern (car mapparts))
(replacement (if (> (length mapparts) 1) (cadr mapparts) "")))
(if replacement
(equal? (string-substitute pattern replacement patha)
(string-substitute pattern replacement pathb))
|