Megatest

Diff
Login

Differences From Artifact [a008a03850]:

To Artifact [f508970062]:


197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
	 (dbexists     (file-exists? dbfullname))
	 (tmpdir       (conc "/tmp/"(current-user-name)))
	 (tmpdb        (let* ((fname (conc tmpdir"/" (string-translate areapath "/" ".")"-"(current-process-id)"-"dbfname)))
			 (if (not (file-exists? tmpdir))(create-directory tmpdir))
			 ;; check if tmpdb already exists, either delete it or
			 ;; add something to the name
			 fname))
	 (inmem        (dbmod:open-inmem-db init-proc
					    (if (eq? (dbcache-mode) 'inmem)
						#f
						tmpdb)
					    ))
	 (write-access (file-write-access? dbpath))
	 (db           (dbmod:safely-open-db dbfullname init-proc write-access))
	 (tables       (db:sync-all-tables-list keys)))
    (if (not (and (sqlite3:database? inmem)
		  (sqlite3:database? db)))
	(begin
	  (debug:print 0 *default-log-port* "ERROR: Failed to properly open "dbfname-in", exiting immediately.")
	  (exit)))
    ;; (assert (sqlite3:database? inmem) "FATAL: open-dbmoddb: inmem is not a db")
    ;; (assert (sqlite3:database? db) "FATAL:  open-dbmoddb: db is not a db")

    (dbr:dbstruct-inmem-set!     dbstruct inmem)
    (dbr:dbstruct-ondiskdb-set!  dbstruct db)
    (dbr:dbstruct-dbfile-set!    dbstruct dbfullname)
    (dbr:dbstruct-dbfname-set!   dbstruct dbfname)
    (dbr:dbstruct-sync-proc-set! dbstruct
				 (lambda (last-update)
				   (if *sync-in-progress*
				       (debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk")
				       (thread-start!
					(make-thread
					 (lambda ()
					   (mutex-lock! *db-with-db-mutex*) ;; this mutex is used when overloaded or during a query that modifies the db
					   (set! *sync-in-progress* #t)
					   #;(dbmod:sync-gasket tables last-update inmem db
					   dbfullname syncdir)
					   (system (conc "megatest -db2db -from "tmpdb" -to "dbfullname))
					   (mutex-unlock! *db-with-db-mutex*)
					   (thread-sleep! 0.5) ;; ensure at least 1/2 second down time between sync calls
					   (set! *sync-in-progress* #f)))))))
    ;; (dbmod:sync-tables tables #f db inmem)
    ;; (if db
    (dbmod:sync-gasket tables #f inmem db dbfullname 'fromdest keys) ;; ) ;; load into inmem
    (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))))








|







<
|



|
|
>
|


|















<
<
<







197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237



238
239
240
241
242
243
244
	 (dbexists     (file-exists? dbfullname))
	 (tmpdir       (conc "/tmp/"(current-user-name)))
	 (tmpdb        (let* ((fname (conc tmpdir"/" (string-translate areapath "/" ".")"-"(current-process-id)"-"dbfname)))
			 (if (not (file-exists? tmpdir))(create-directory tmpdir))
			 ;; check if tmpdb already exists, either delete it or
			 ;; add something to the name
			 fname))
	 #;(inmem        (dbmod:open-inmem-db init-proc
					    (if (eq? (dbcache-mode) 'inmem)
						#f
						tmpdb)
					    ))
	 (write-access (file-write-access? dbpath))
	 (db           (dbmod:safely-open-db dbfullname init-proc write-access))
	 (tables       (db:sync-all-tables-list keys)))

    (if (not (sqlite3:database? db)) ;; db is our master database in the .mtdb dir
	(begin
	  (debug:print 0 *default-log-port* "ERROR: Failed to properly open "dbfname-in", exiting immediately.")
	  (exit)))
    ;; we sync to tmpdb here so that we use file-copy to get intial database
    (dbmod:db-to-db-sync dbfullname tmpdb 0 init-proc keys)
    (let* ((inmem (dbmod:open-inmem-db init-proc tmpdb)))
      (dbr:dbstruct-inmem-set!     dbstruct inmem))
    (dbr:dbstruct-ondiskdb-set!  dbstruct db)
    (dbr:dbstruct-dbfile-set!    dbstruct dbfullname)
;    (dbr:dbstruct-dbfname-set!   dbstruct dbfname)
    (dbr:dbstruct-sync-proc-set! dbstruct
				 (lambda (last-update)
				   (if *sync-in-progress*
				       (debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk")
				       (thread-start!
					(make-thread
					 (lambda ()
					   (mutex-lock! *db-with-db-mutex*) ;; this mutex is used when overloaded or during a query that modifies the db
					   (set! *sync-in-progress* #t)
					   #;(dbmod:sync-gasket tables last-update inmem db
					   dbfullname syncdir)
					   (system (conc "megatest -db2db -from "tmpdb" -to "dbfullname))
					   (mutex-unlock! *db-with-db-mutex*)
					   (thread-sleep! 0.5) ;; ensure at least 1/2 second down time between sync calls
					   (set! *sync-in-progress* #f)))))))



    (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))))

387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
					      ");"))
				   (proc (lambda ()
					   (apply sqlite3:execute db qry row))))
			      ;; (debug:print-info 0 *default-log-port* "qry="qry)
			      (handle-exceptions ;; on exception do the cleanup qry then try one more time
				  exn
				(begin
				  (clean-up-qry id)
				  (proc))
				(proc)))))
			      
	 (num-inserts     0)
	 (num-updates     0)
	 )
    ;; (debug:print-info 0 *default-log-port* "field-names: "field-names", fields-sans-lu: "fields-sans-lu)
    (sqlite3:with-transaction
     from-db
     (lambda ()
       (let* ((from-ids (get-ids from-db)))
	 ;; (debug:print-info 0 *default-log-port* "Table "tablename", has "(length from-ids)" records.")
 	 (sqlite3:with-transaction
 	  to-db
	  (lambda ()
	    (let* ((to-ids (get-ids to-db)))
	      ;; (debug:print 0 *default-log-port* "to-ids="to-ids)







|







|
|
|







384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
					      ");"))
				   (proc (lambda ()
					   (apply sqlite3:execute db qry row))))
			      ;; (debug:print-info 0 *default-log-port* "qry="qry)
			      (handle-exceptions ;; on exception do the cleanup qry then try one more time
				  exn
				(begin
				  ;; (clean-up-qry id)
				  (proc))
				(proc)))))
			      
	 (num-inserts     0)
	 (num-updates     0)
	 )
    ;; (debug:print-info 0 *default-log-port* "field-names: "field-names", fields-sans-lu: "fields-sans-lu)
    ;; (sqlite3:with-transaction
    ;;  from-db
    ;;  (lambda ()
       (let* ((from-ids (get-ids from-db)))
	 ;; (debug:print-info 0 *default-log-port* "Table "tablename", has "(length from-ids)" records.")
 	 (sqlite3:with-transaction
 	  to-db
	  (lambda ()
	    (let* ((to-ids (get-ids to-db)))
	      ;; (debug:print 0 *default-log-port* "to-ids="to-ids)
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
			  (if (not (equal? from-val dest-val))
			      (let* ((qry-proc (lambda ()
						 (sqlite3:execute to-db (conc "UPDATE "tablename" SET "fieldname"=? WHERE id=?;")
								  from-val from-id))))
				(handle-exceptions ;; try to remove the offending record and re-try once the update
				    exn
				  (begin
				    (clean-up-qry from-id)
				    (qry-proc))
				  (qry-proc))
				(set! num-updates (+ num-updates 1))))))
		      fields-sans-lu)
		     (let ((row (get-row from-db from-id))) ;; need to insert the row
		       ;; (debug:print 0 *default-log-port* "row="row)
		       (set! num-inserts (+ num-inserts 1))
		       (ins-row to-db from-id row))))
	       from-ids)))))))
    (+ num-inserts num-updates)))

;;     (for-each ;; table
;;      (lambda (tabledat)
;;        (let* ((tablename        (car tabledat))
;; 	      (fields           (cdr tabledat))
;; 	      (has-last-update  (member "last_update" fields))







|








|







422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
			  (if (not (equal? from-val dest-val))
			      (let* ((qry-proc (lambda ()
						 (sqlite3:execute to-db (conc "UPDATE "tablename" SET "fieldname"=? WHERE id=?;")
								  from-val from-id))))
				(handle-exceptions ;; try to remove the offending record and re-try once the update
				    exn
				  (begin
				    ;; (clean-up-qry from-id)
				    (qry-proc))
				  (qry-proc))
				(set! num-updates (+ num-updates 1))))))
		      fields-sans-lu)
		     (let ((row (get-row from-db from-id))) ;; need to insert the row
		       ;; (debug:print 0 *default-log-port* "row="row)
		       (set! num-inserts (+ num-inserts 1))
		       (ins-row to-db from-id row))))
	       from-ids)))))
    (+ num-inserts num-updates)))

;;     (for-each ;; table
;;      (lambda (tabledat)
;;        (let* ((tablename        (car tabledat))
;; 	      (fields           (cdr tabledat))
;; 	      (has-last-update  (member "last_update" fields))
933
934
935
936
937
938
939
940
941
942

943
944
945
946
947
948













949
950
951
952



953
954
955
956
			(or newstatus currstate "UNKNOWN")
			run-id testname)))))
;;======================================================================
;; db to db sync
;;======================================================================

(define (dbmod:db-to-db-sync src-db dest-db last-update init-proc keys)
  (if (and (file-exists? src-db)
	   (file-read-access? src-db))
      (let* ((d-wr   (or (and (file-exists? dest-db)

			      (file-write-access? dest-db)) ;; exists and writable
			 (let* ((dirname (or (pathname-directory dest-db)
					     ".")))
			   (if dirname
			       (file-exists? dirname)
			       (file-write-access? dirname)))))













	     (tables (db:sync-all-tables-list keys))
	     (sdb    (dbmod:safely-open-db src-db init-proc #t))
	     (ddb    (dbmod:safely-open-db dest-db init-proc d-wr)))
	(dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys))



      #f
      ))

)







|

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


930
931
932
933
934
935
936
937
938
939
940
941
942
943

944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966

967
968
			(or newstatus currstate "UNKNOWN")
			run-id testname)))))
;;======================================================================
;; db to db sync
;;======================================================================

(define (dbmod:db-to-db-sync src-db dest-db last-update init-proc keys)
  (if (and (file-exists? src-db) ;; can't proceed without a source
	   (file-read-access? src-db))
      (let* ((have-dest     (file-exists? dest-db))
	     (dest-file-wr  (and have-dest
				 (file-write-access? dest-db))) ;; exists and writable
	     (dest-dir      (or (pathname-directory dest-db)
				"."))

	     (dest-dir-wr   (and (file-exists? dest-dir)
				 (file-write-access? dest-dir)))
	     (d-wr          (or (and have-dest
				     dest-file-wr)
				dest-dir-wr))
	     (copied        (if (and (not have-dest)
				     dest-dir-wr)
				(begin
				  (file-copy src-db dest-db)
				  #t)
				#f)))
	(if copied
	    (begin
	      (debug:print-info 0 *default-log-port* "db-to-db-sync done with file-copy")
	      #t)
	    (let* ((tables (db:sync-all-tables-list keys))
		   (sdb    (dbmod:safely-open-db src-db init-proc #t))
		   (ddb    (dbmod:safely-open-db dest-db init-proc d-wr))
		   (res    (dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys)))
	      (sqlite3:finalize! sdb)
	      (sqlite3:finalize! ddb)
	      res)))
      #f))


)