Megatest

Diff
Login

Differences From Artifact [c0d005cd6b]:

To Artifact [e21b719c87]:


137
138
139
140
141
142
143







144
145











146

147
148
149
150
151
152
153
154
155
156
			    db))))
	 (tables       (db:sync-all-tables-list keys)))
    (dbr:dbstruct-inmem-set!    dbstruct inmem)
    (dbr:dbstruct-ondiskdb-set! dbstruct db)
    (dbr:dbstruct-dbfile-set!   dbstruct dbfullname)
    (dbr:dbstruct-sync-proc-set! dbstruct
				 (lambda (last-update)







				   (if (eq? syncdir 'todisk) ;; sync to disk normally, sync from in dashboard
				       (dbmod:sync-tables tables last-update inmem db)











				       (dbmod:sync-tables tables last-update db inmem))))

    (dbmod:sync-tables tables #f db inmem)
    (dbr:dbstruct-last-update-set! dbstruct (current-seconds)) ;; should this be offset back in time by one second?
    dbstruct))

(define (dbmod:close-db dbstruct)
  ;; do final sync to disk file
  ;; (do-sync ...)
  (sqlite3:finalize! (dbr:dbstruct-ondiskdb dbstruct)))

;;======================================================================







>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|
<







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
167

168
169
170
171
172
173
174
			    db))))
	 (tables       (db:sync-all-tables-list keys)))
    (dbr:dbstruct-inmem-set!    dbstruct inmem)
    (dbr:dbstruct-ondiskdb-set! dbstruct db)
    (dbr:dbstruct-dbfile-set!   dbstruct dbfullname)
    (dbr:dbstruct-sync-proc-set! dbstruct
				 (lambda (last-update)
				   (sync-gasket tables last-update inmem db
						dbfullname syncdir)))
    ;; (dbmod:sync-tables tables #f db inmem)
    (sync-gasket tables #f inmem db dbfullname 'fromdest)
    (dbr:dbstruct-last-update-set! dbstruct (current-seconds)) ;; should this be offset back in time by one second?
    dbstruct))

;;    (if (eq? syncdir 'todisk) ;; sync to disk normally, sync from in dashboard
;;        (dbmod:sync-tables tables last-update inmem db)
;;        (dbmod:sync-tables tables last-update db inmem))))

;; direction: 'fromdest 'todest
;;
(define (sync-gasket tables last-update inmem dbh dbfname direction)
  (case (dbfile:sync-method)
    ((attach)
     (dbmod:attach-sync tables inmem dbfname direction))
    (else
     (case direction
       ((todest)
	(dbmod:sync-tables tables last-update inmem dbh))
       (else
	(dbmod:sync-tables tables last-update dbh inmem))))))



(define (dbmod:close-db dbstruct)
  ;; do final sync to disk file
  ;; (do-sync ...)
  (sqlite3:finalize! (dbr:dbstruct-ondiskdb dbstruct)))

;;======================================================================
305
306
307
308
309
310
311












312
313
314
315





316
317
318
319
320
321

322
323
324




325
326
327
328
329
330
331
332
333
334
335
336
337
338


339

340



341
342
343
344
345

346
347
348





349
350
351
352
353
354
       (lambda (dat)
	 (let ((tblname (car dat))
	       (count   (cdr dat)))
	   (set! tot-count (+ tot-count count)))) 
       (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
    tot-count))













;; direction = fromdest, todest
;; mode = 'full, 'incr
;;
(define (dbmod:attach-sync tables dbh destdbfile direction #!key (mode 'full))





  (let* ((dest-exists  (file-exists? destdbfile)))
    (assert dest-exists "FATAL: sync called with non-existant file, "destdbfile)
    ;; attach the destdbfile
    ;; for each table
    ;;    insert into dest.<table> select * from src.<table> where last_update>last_update
    ;; done

    (sqlite3:execute dbh "ATTACH ? AS auxdb;" destdbfile)
    (for-each
     (lambda (table)




       (let* ((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
			   "tests.last_update > "todb table".last_update;")))
	 ;; (print "stmt1: "stmt1)


	 ;; (print "stmt2: "stmt2)

	 ;; (print "stmt3: "stmt4)



	 ;; (print "stmt1: "stmt1)
	 (sqlite3:execute dbh stmt4)
	 (sqlite3:execute dbh stmt1)
	 ;; (sqlite3:execute dbh stmt1)
	 ;; (sqlite3:execute dbh stmt2)

	 (sqlite3:execute dbh "DETACH auxdb;")))
     tables)))






;;======================================================================
;; Moved from dbfile
;;======================================================================


)







>
>
>
>
>
>
>
>
>
>
>
>



|
>
>
>
>
>
|





>
|


>
>
>
>
|











|
|
>
>
|
>
|
>
>
>
|
|
|
|
|
>

|

>
>
>
>
>






323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
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
       (lambda (dat)
	 (let ((tblname (car dat))
	       (count   (cdr dat)))
	   (set! tot-count (+ tot-count count)))) 
       (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
    tot-count))

(define (has-last-update dbh tablename)
  (let* ((has-last #f))
    (sqlite3:for-each-row
     (lambda (name)
       (if (equal? name "last_update")
	   (set! has-last #t)))
     dbh
     (conc "SELECT name FROM pragma_table_info('"tablename"') as tblInfo;"))
    has-last))

;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
;;
;; direction = fromdest, todest
;; mode = 'full, 'incr
;;
(define (dbmod:attach-sync tables dbh destdbfile direction #!key
			   (mode 'full)
			   (no-update '("keys")) ;; do
			   )
  (debug:print 0 *default-log-port* "Doing sync "direction" "destdbfile)
  (let* ((table-names  (map car tables))
	 (dest-exists  (file-exists? destdbfile)))
    (assert dest-exists "FATAL: sync called with non-existant file, "destdbfile)
    ;; attach the destdbfile
    ;; 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";"))
	      )
	 ;; (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)
	    ))
	 (sqlite3:execute dbh "DETACH auxdb;")))
     table-names)))

;; prefix is "" or "auxdb."
;;
;; (define (dbmod:last-update-patch dbh prefix)
;;   (let ((
  
;;======================================================================
;; Moved from dbfile
;;======================================================================


)