Overview
Context
Changes
Modified common.scm
from [4838fd1409]
to [1402f87c8b].
︙ | | |
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
|
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
|
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
)
;;======================================================================
;; Move me elsewhere ...
;; RADT => Why do we meed the version check here, this is called only if version misma
;;
(define (common:cleanup-db dbstruct #!key (full #f))
(case (rmt:transport-mode)
((http)
(apply db:multi-db-sync
dbstruct
'schema
'killservers
'adj-target
'new2old
'(dejunk)
)
(apply db:multi-db-sync
dbstruct
'schema
'killservers
'adj-target
'new2old
'(dejunk)
))
((tcp nfs)
(debug:print 0 *default-log-port* "WARNING: cleanup-db NOT implemented yet for tcp and nfs.")
#;(apply db:multi-db-sync
dbstruct
'schema
'killservers
'adj-target
'new2old
'(dejunk)
)))
(if (common:api-changed?)
(common:set-last-run-version)))
(define (common:snapshot-file filepath #!key (subdir ".") )
(if (file-exists? filepath)
(let* ((age-sec (lambda (file)
(if (file-exists? file)
|
︙ | | |
Modified dbmod.scm
from [e21b719c87]
to [cad5788f26].
︙ | | |
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
|
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
|
-
-
+
+
+
+
-
+
-
|
;; for each table
;; insert into dest.<table> select * from src.<table> where last_update>last_update
;; done
(debug:print 0 *default-log-port* "Attaching "destdbfile" as auxdb")
(sqlite3:execute dbh (conc "ATTACH '"destdbfile"' AS auxdb;"))
(for-each
(lambda (table)
(debug:print 0 *default-log-port* "Syncing table "table)
(let* ((tbldat (alist-ref table tables equal?))
(fields (map car tbldat))
(fields-str (string-intersperse fields ","))
(dir (eq? direction 'todest))
(fromdb (if dir "" "auxdb."))
(todb (if dir "auxdb." ""))
(stmt1 (conc "INSERT OR IGNORE INTO "todb table
" SELECT * FROM "fromdb table";"))
(stmt2 (conc "INSERT OR REPLACE INTO "todb table
" SELECT * FROM "fromdb table" WHERE "
fromdb table".last_update > "
todb table".last_update;"))
(stmt3 (conc "INSERT OR REPLACE INTO "todb"."table
" SELECT * FROM "fromdb table";"))
(stmt4 (conc "DELETE FROM "todb table" WHERE "fromdb
table ".last_update > "todb table".last_update;"))
(stmt5 (conc "DELETE FROM "todb table";"))
(stmt6 (conc "INSERT OR REPLACE INTO "todb table" ("fields-str") SELECT "fields-str" FROM "fromdb table";"))
)
(start-ms (current-milliseconds)))
;; (if (not (has-last-update dbh table))
;; (sqlite3:execute dbh (conc "ALTER TABLE "table" ADD COLUMN last_update INTEGER;")))
;; (if (not (has-last-update dbh (conc "auxdb."table)))
;; (sqlite3:execute dbh (conc "ALTER TABLE auxdb."table" ADD COLUMN last_update INTEGER;")))
(sqlite3:with-transaction
dbh
(lambda ()
(sqlite3:execute dbh stmt5)
;; (sqlite3:execute dbh stmt4) ;; if it worked this would be better for incremental up
;; (sqlite3:execute dbh stmt1)
(sqlite3:execute dbh stmt6)
))
(debug:print 0 *default-log-port* "Synced table "table" in "(- (current-milliseconds) start-ms)"ms")
))
table-names)
(sqlite3:execute dbh "DETACH auxdb;")))
(sqlite3:execute dbh "DETACH auxdb;")))
table-names)))
;; prefix is "" or "auxdb."
;;
;; (define (dbmod:last-update-patch dbh prefix)
;; (let ((
;;======================================================================
;; Moved from dbfile
;;======================================================================
)
|
Modified server.scm
from [1ebaa53b59]
to [4124af2653].
︙ | | |
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
|
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
|
-
-
+
+
|
(am-home? (lambda ()
(let* ((currhost (get-host-name))
(bestadrs (server:get-best-guess-address currhost)))
(or (equal? host currhost)
(equal? host bestadrs))))))
(case mode
((info)
(print "oldest: "oldest-dat", selected host: "host", all-valid: "all-valid)
(print "youngest: "(hash-table-ref serversdat (car all-valid))))
(debug:print 0 *default-log-port* "oldest: "oldest-dat", selected host: "host", all-valid: "all-valid)
(debug:print 0 *default-log-port* "youngest: "(hash-table-ref serversdat (car all-valid))))
((home) host)
((homehost) (cons host (am-home?))) ;; shut up old code
((home?) (am-home?))
((best-ten)(names->dats (best-ten)))
((all-valid)(names->dats all-valid))
((best) (let* ((best-ten (best-ten))
(len (length best-ten)))
|
︙ | | |