Megatest

Check-in [81dd2a2efe]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Sorta working but not really...
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-servload
Files: files | file ages | folders
SHA1: 81dd2a2efed088eeafb68058ac55564220533444
User & Date: matt on 2023-05-03 21:49:46
Other Links: branch diff | manifest | tags
Context
2023-05-03
22:05
wip check-in: 1e38d0d69d user: matt tags: v1.80-servload
21:49
Sorta working but not really... check-in: 81dd2a2efe user: matt tags: v1.80-servload
19:05
wip check-in: 0ba83c29bb user: mrwellan tags: v1.80-servload
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [6812b9630b] to [1094c8727d].

︙
109
110
111
112
113
114
115
116

117
118
119
120
121
122
123

109
110
111
112
113
114
115

116
117
118
119
120
121
122
123








-
+








# ARCHSTR=$(BASH_MACHTYPE)_$(shell lsb_release -sr)
ARCHSTR=$(shell if [[ -e /usr/bin/sw_vers ]]; then /usr/bin/sw_vers -productVersion; else lsb_release -sr; fi)
# ARCHSTR=$(shell bash -c "echo \$$MACHTYPE")

PNGFILES = $(shell cd docs/manual;ls *png)


mtest: $(OFILES) readline-fix.scm $(MOFILES) $(MOIMPFILES) megatest.o  megatest-version.scm
mtest: $(OFILES) readline-fix.scm $(MOFILES) $(MOIMPFILES) megatest.o  megatest-version.scm transport-mode.scm
	csc $(CSCOPTS) $(OFILES) $(MOFILES) $(MOIMPFILES) megatest.o -o mtest

showmtesthash:
	@echo $(MTESTHASH)

dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) megatest-version.scm megatest-fossil-hash.scm
	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) -o dboard
︙

Modified dbmod.scm from [4ac7149f64] to [7ef30ab344].

︙
231
232
233
234
235
236
237
238

239
240
241
242
243
244
245
246
247
248

249
250
251
252
253
254
255
256
257
258
259
260
261

262
263
264

265
266
267
268
269
270
271

231
232
233
234
235
236
237

238
239
240
241
242
243
244
245
246
247

248
249
250
251
252
253
254
255
256
257
258
259
260

261
262
263

264
265
266
267
268
269
270
271








-
+









-
+












-
+


-
+








					 dbfullname syncdir)
					 (system (conc "megatest -db2db -from "tmpdb" -to "dbfname"&"))
					 (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) ;; ) ;; load into inmem
    (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))))

;; direction: 'fromdest 'todest
;;
(define (dbmod:sync-gasket tables last-update inmem dbh dbfname direction)
(define (dbmod:sync-gasket tables last-update inmem dbh dbfname direction keys)
  (assert (sqlite3:database? inmem) "FATAL: sync-gasket: inmem is not a db")
  (assert (sqlite3:database? dbh) "FATAL: sync-gasket: dbh is not a db")
  (debug:print-info 0 *default-log-port* "Db sync using "(dbfile:sync-method)" method")
  (case (dbfile:sync-method)
    ((none) #f)
    ((attach)
     (dbmod:attach-sync tables inmem dbfname direction))
    ((newsync) ;; DON'T USE THIS ONE. IT IS BORKED
     (dbmod:new-sync tables inmem dbh dbfname direction))
    (else
     (case direction
       ((todisk)
	(dbmod:sync-tables tables last-update inmem dbh)
	(dbmod:sync-tables tables last-update keys inmem dbh)
	)
       (else
	(dbmod:sync-tables tables last-update dbh inmem))))))
	(dbmod:sync-tables tables last-update keys dbh inmem))))))

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

;;======================================================================
︙
293
294
295
296
297
298
299
300

301
302
303
304







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

293
294
295
296
297
298
299

300
301
302


303
304
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
355
356
357








-
+


-
-
+
+
+
+
+
+
+










-
+








-
-
+
+
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








;;
;; if last-update specified ("field-name" . time-in-seconds)
;;    then sync only records where field-name >= time-in-seconds
;;    IFF field-name exists
;;
;; Use (db:sync-all-tables-list keys) to get the tbls input
;;
(define (dbmod:sync-tables tbls last-update fromdb todb)
(define (dbmod:sync-tables tbls last-update keys fromdb todb)
  (assert (sqlite3:database? fromdb) "FATAL: dbmod:sync-tables called with fromdb not a database" fromdb)
  (assert (sqlite3:database? todb) "FATAL: dbmod:sync-tables called with fromdb not a database" todb)
  (let ((specials    '(("keys" . "fieldname")
		       ("meta" . "var")))
  (let ((specials    `(("keys" "fieldname")
		       ("metadat" "var")
		       ,(cons "runs" (cons "runname" keys))
		       ("tests" "run_id" "testname" "item_path")
		       ("test_meta" "testname")
		       ("test_steps" "test_id" "stepname" "state")
		       ("test_data" "test_id" "category" "variable")))
	(stmts       (make-hash-table)) ;; table-field => stmt
	(all-stmts   '())              ;; ( ( stmt1 value1 ) ( stml2 value2 ))
	(numrecs     (make-hash-table))
	(start-time  (current-milliseconds))
	(tot-count   0))
    (for-each ;; table
     (lambda (tabledat)
       (let* ((count (match tabledat
		       ((tablename . fields)
			(debug:print-info 0 *default-log-port* "Syncing table "tablename)
			(dbmod:sync-table tablename fields fromdb todb (alist-ref tablename specials equal?)))
			(dbmod:sync-table tablename fields fromdb todb specials))
		       (else
			(debug:print-warn 0 *default-log-port* "Bad tabledat entry: "tabledat)
			0))))
	 (set! tot-count (+ tot-count count))))
     tbls)
    (debug:print-info 0 *default-log-port* "dbmod:sync-tables completed in "(- (current-milliseconds) start-time)"ms")
    tot-count))

(define (dbmod:sync-table tablename fields from-db to-db keyfield)
  (let* ((field-names      (map car fields))
(define (dbmod:sync-table tablename fields from-db to-db specials)
  (let* ((key-fields       (alist-ref tablename specials equal?))
	 (field-names      (map car fields))
	 (has-last-update  (member "last_update" field-names))
	 (fields-sans-lu   (filter (lambda (x)
				     (not (member x '("id" "last_update"))))
				   field-names))
	 (get-vals        (lambda (db id fields)
			    (debug:print-info 0 *default-log-port* "get-vals: fields="fields", id="id)
			    (let* ((qry (conc "SELECT "(string-intersperse fields ",")" FROM "tablename" WHERE id=?;"))
				   (res #f))
			      (sqlite3:for-each-row
			       (lambda tuple
				 (set! res tuple))
			       db qry id)
			      res)))
	 (clean-up-qry    (lambda (from-id)
			    (debug:print-info 0 *default-log-port* "key-fields="key-fields", from-id="from-id)
			    (let* ((vals (get-vals from-db from-id key-fields))
				   (qry  (conc "DELETE FROM "tablename" WHERE "(string-intersperse key-fields "=? AND ")"=?;")))
			      (debug:print-info 0 *default-log-port* "qry: "qry", vals="vals)
			      (apply sqlite3:execute to-db qry vals))))
	 (get-ids          (lambda (db)
			     (sqlite3:fold-row (lambda (res id)
						 (cons id res))
					       '()
					       db
					       (conc "SELECT id FROM "tablename";"))))
	 (get-val          (lambda (db fieldname id)
︙
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

408
409
410
411
412
413
414

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
408
409
410
411
412
413
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








-
+
+
+

+
-
-
-
+
+
+
+
+
+




-
-
-
+
+
+


-
-
-
+
+
+
















-
-
-
-
+
+
+
+
+
+
+
+
+






-
+








	 (ins-row         (lambda (db id row)
			    (let* ((qry (conc "INSERT INTO "tablename" (id,"
					      (string-intersperse fields-sans-lu ",")
					      ") VALUES ("id","
					      (string-intersperse
					       (make-list (length fields-sans-lu) "?")
					       ",")
					      ");")))
					      ");"))
				   (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
			      (apply sqlite3:execute db
				     qry
				     row))))
				  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 ()
    (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 ()
 	 (sqlite3:with-transaction
 	  to-db
	  (lambda ()
	    (let* ((to-ids (get-ids to-db)))
	      ;; (debug:print 0 *default-log-port* "to-ids="to-ids)
	      (for-each ;; from-id
	       (lambda (from-id)
		 (if (member from-id to-ids)
		     (for-each ;; case where record exists, do one by one the fields if different
		      (lambda (fieldname)
			(let* ((from-val (get-val from-db fieldname from-id))
			       (dest-val (get-val to-db   fieldname from-id)))
			  #;(debug:print 0 *default-log-port*
				       "fieldname="fieldname
				       ", from-id="from-id
				       ", from-val="from-val
				       ", dest-val="dest-val
				       )
			  (if (not (equal? from-val dest-val))
			      (begin
				(sqlite3:execute to-db (conc "UPDATE "tablename" SET "fieldname"=? WHERE id=?;")
						 from-val
						 from-id)
			      (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)));; ))))
	       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))
︙
911
912
913
914
915
916
917
918

919
920

943
944
945
946
947
948
949

950
951
952








-
+



					     ".")))
			   (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))))
	(dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys))))

)

This page was generated in about 0.129s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00