Megatest

Changes On Branch e973b1fb774e7398
Login

Changes In Branch v1.80-cleanup Excluding Merge-Ins

This is equivalent to a diff from 19861e6399 to e973b1fb77

2023-02-10
21:16
Merge v1.80-cleanup as it passed QA check-in: 34c5263e66 user: matt tags: v1.80
21:06
Merging pretty good branch v1.80-dbperf to v1.80 check-in: 7170e5f43b user: matt tags: v1.80
20:19
Use debugprint module in dbfile module as stepping stone to replacing old debug:print calls with new. Closed-Leaf check-in: 0e8fa15f1d user: matt tags: v1.80-debugprint
2023-02-06
19:35
Squashed v1.80-dbperformance into one commit check-in: 6c7b8be468 user: matt tags: v1.80-dbperf
2023-02-05
11:47
Minor clean up. There were a couple communication errors in sixtyfivek but they looked likely to be host related. Closed-Leaf check-in: e973b1fb77 user: matt tags: v1.80-cleanup
08:36
wip, close idle db connections check-in: 97a3c4ad11 user: matt tags: v1.80-close-idle-connections
2023-02-03
02:16
Reduce load from get-state-status-and-roll-up-run. check-in: 4e634eb46a user: matt tags: v1.80-dbperformance
2023-02-02
12:54
Use an actual droop check-in: 19861e6399 user: matt tags: v1.80
09:27
Change couple queries to use prepared statements check-in: a2e41e0613 user: matt tags: v1.80

Modified db.scm from [66cca5d3c4] to [b67cfa89a8].

469
470
471
472
473
474
475















476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558


559
560



561
562
563
564
565
566
567
568
569


570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
				(- (current-milliseconds) start-time)))
	     (debug:print-info 3 *default-log-port* "skipping sync. " file " is up to date")
         )))
     dbfiles)
    (if dbdat (dbfile:add-dbdat dbstruct #f dbdat)))
  #t)
















;; options:
;;
;;  'killservers  - kills all servers
;;  'dejunk       - removes junk records
;;  'adj-testids  - move test-ids into correct ranges
;;  'old2new      - sync megatest.db to /tmp/.../megatest.db and /tmp/.../megatest_ref.db
;;  'new2old      - sync /tmp/.../megatest.db to megatest.db and /tmp/.../megatest_ref.db (and update data_synced)
;;  'closeall     - close all opened dbs
;;  'schema       - attempt to apply schema changes
;;  run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync dbstruct . options)
  (let* (;; (dbdat       (db:open-db dbstruct #f dbfile:db-init-proc))
	 (data-synced 0) ;; count of changed records
    (tmp-area       (common:get-db-tmp-area))
    (old2new (member 'old2new options))
    (dejunk (member 'dejunk options))
    (killservers (member 'killservers options))
    (servers (server:choose-server *toppath* 'all-valid)) ;; (server:get-list *toppath*))
    (src-area (if old2new *toppath* tmp-area))
    (dest-area (if old2new tmp-area *toppath*))
    (dbfiles        (if old2new (glob (conc *toppath* "/.megatest/*.db")) (glob (conc tmp-area "/.megatest/*.db"))))
    (keys (db:get-keys dbstruct))
    (sync-durations (make-hash-table)))


    (if (and killservers servers)
      (begin
       	  (for-each
	   (lambda (server)
             (handle-exceptions
             exn
             (begin 
               (debug:print-info 0 *default-log-port*  "Unable to get host and/or port from " server ", exn=" exn)     
               #f)
	     (match-let (((mod-time host port start-time server-id pid) server))
	       (if (and host pid)
		   (tasks:kill-server host pid)))))
	   servers)
          (delete-file* (common:get-sync-lock-filepath))
      )
    )

    (if (not dbfiles)
      (debug:print-error 0 *default-log-port* "no dbfiles found in " (conc *toppath* "/.megatest"))
    (for-each
     (lambda (srcfile)
       (debug:print-info 3 *default-log-port* "file: " srcfile)
       (let* ((fname (conc (pathname-file srcfile) ".db"))
              (basename (pathname-file srcfile))
              (run-id (if (string= basename "main") #f (string->number basename)))
	      (destfile (conc dest-area "/.megatest/" fname))
              (dest-directory  (conc dest-area "/.megatest/"))
              (dummy (debug:print-info 2 *default-log-port* "destfile = " destfile))
              (dummy2 (debug:print-info 2 *default-log-port* "dejunk = " dejunk))
	      (time1 (file-modification-time srcfile))
              (time2 (if (file-exists? destfile)
                         (begin
                            (debug:print-info 2 *default-log-port* "destfile " destfile " exists")
			    (file-modification-time destfile)
                         )
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file " destfile)
			   0)))
	      (changed ( < (- time2 time1) 6.0)) ;; dest db not updated within last 6 seconds

      (do-cp (cond
		      ((not (file-exists? destfile)) ;; shouldn't happen, but this might recover
		       (debug:print-info 2 *default-log-port* "File " destfile " not found. Copying "srcfile" to "destfile)
                       ;; TODO: Need to fix this for WAL mod. Can't just copy.
                       (system (conc "/bin/mkdir -p " dest-directory))
                       (system (conc "/bin/cp " srcfile " " destfile))
		       #t)
		      (changed ;; (and changed
		       ;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed.
		       #t)
		      ((and changed *time-to-exit*) ;; last sync
		       #t)
		      (else
		       #f))))
          (if (or dejunk do-cp)
	     (let* (
                    (start-time (current-milliseconds))



                    (subdb (or (dbfile:get-subdb dbstruct run-id) (dbfile:init-subdb dbstruct run-id dbfile:db-init-proc)))
                    (mtdb      (dbr:subdb-mtdbdat subdb))



                    (tmpdb     (dbfile:open-db dbstruct run-id dbfile:db-init-proc))

                    )
	       (debug:print-info 2 *default-log-port* "delta syncing file: " srcfile ", time diff: " (- time1 time2) " seconds")

               (if old2new
                 (begin
                   (if dejunk (db:clean-up run-id mtdb))
		   (db:sync-tables (db:sync-all-tables-list dbstruct (db:get-keys dbstruct)) #f mtdb tmpdb)


                 )
                 (begin
                   (if dejunk (db:clean-up run-id tmpdb))
		   (db:sync-tables (db:sync-all-tables-list dbstruct (db:get-keys dbstruct)) #f tmpdb mtdb)
                 )
               )
	       (hash-table-set! sync-durations (conc srcfile ".db") (- (current-milliseconds) start-time)))
	     (debug:print-info 2 *default-log-port* "skipping delta sync. " srcfile " is up to date")
          )
       )
     )
     dbfiles
    )
    )
    data-synced
  )
)



;; Sync all changed db's
;;
(define (db:tmp->megatest.db-sync dbstruct run-id last-update)
  (let* ((subdbs (hash-table-values (dbr:dbstruct-subdbs dbstruct)))
	 (res    '()))
    (for-each







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














|
|
|
|
<
|
|
|
|
|

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

|
|
|
|
|
|
|
|
|
<
<
|
|
|
|
|
<
|
|
|
|

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







469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508

509
510
511
512
513
514
515
516













517


518
519
520
521
522
523
524
525
526
527


528
529
530
531
532

533
534
535
536
537
538
539
540
541
542
543
544
545

546
547
548
549
550
551

552
553
554
555
556
557
558
559
560
561
562

563

564
565
566
567
568
569
570
571
572
573


574
575



576


577




578
579
580
581
582
583
584
				(- (current-milliseconds) start-time)))
	     (debug:print-info 3 *default-log-port* "skipping sync. " file " is up to date")
         )))
     dbfiles)
    (if dbdat (dbfile:add-dbdat dbstruct #f dbdat)))
  #t)

(define (db:kill-servers)
  (let* ((servers (server:choose-server *toppath* 'all-valid))) ;; (server:get-list *toppath*))
    (for-each
     (lambda (server)
       (handle-exceptions
           exn
         (begin 
           (debug:print-info 0 *default-log-port*  "Unable to get host and/or port from " server ", exn=" exn)     
           #f)
	 (match-let (((mod-time host port start-time server-id pid) server))
		    (if (and host pid)
			(tasks:kill-server host pid)))))
     servers)
    (delete-file* (common:get-sync-lock-filepath))))

;; options:
;;
;;  'killservers  - kills all servers
;;  'dejunk       - removes junk records
;;  'adj-testids  - move test-ids into correct ranges
;;  'old2new      - sync megatest.db to /tmp/.../megatest.db and /tmp/.../megatest_ref.db
;;  'new2old      - sync /tmp/.../megatest.db to megatest.db and /tmp/.../megatest_ref.db (and update data_synced)
;;  'closeall     - close all opened dbs
;;  'schema       - attempt to apply schema changes
;;  run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync dbstruct . options)
  (let* (;; (dbdat       (db:open-db dbstruct #f dbfile:db-init-proc))
	 (data-synced 0) ;; count of changed records
	 (tmp-area       (common:get-db-tmp-area))
	 (old2new (member 'old2new options))
	 (dejunk (member 'dejunk options))
	 (killservers (member 'killservers options))

	 (src-area (if old2new *toppath* tmp-area))
	 (dest-area (if old2new tmp-area *toppath*))
	 (dbfiles        (if old2new (glob (conc *toppath* "/.megatest/*.db")) (glob (conc tmp-area "/.megatest/*.db"))))
	 (keys (db:get-keys dbstruct))
	 (sync-durations (make-hash-table)))

    ;; kill servers
    (if (and killservers servers)(db:kill-servers))













    


    (if (not dbfiles)
	(debug:print-error 0 *default-log-port* "no dbfiles found in " (conc *toppath* "/.megatest"))
	(for-each
	 (lambda (srcfile)
	   (debug:print-info 3 *default-log-port* "file: " srcfile)
	   (let* ((fname    (conc (pathname-file srcfile) ".db"))
		  (basename (pathname-file srcfile))
		  (run-id   (if (string= basename "main") #f (string->number basename)))
		  (destfile (conc dest-area "/.megatest/" fname))
		  (dest-directory  (conc dest-area "/.megatest/"))


		  (time1    (file-modification-time srcfile))
		  (time2    (if (file-exists? destfile)
				(begin
				  (debug:print-info 2 *default-log-port* "destfile " destfile " exists")
				  (file-modification-time destfile))

				(begin
				  (debug:print-info 0 *default-log-port* "Sync - I do not see file " destfile)
				  0)))
		  (changed   ( < (- time2 time1) 6.0)) ;; dest db not updated within last 6 seconds

		  (do-cp     (cond
			      ((not (file-exists? destfile)) ;; shouldn't happen, but this might recover
			       (debug:print-info 2 *default-log-port* "File " destfile " not found. Copying "srcfile" to "destfile)
			       ;; TODO: Need to fix this for WAL mod. Can't just copy.
			       (system (conc "/bin/mkdir -p " dest-directory))
			       (system (conc "/bin/cp " srcfile " " destfile))
			       #t)
			      (changed ;; (and changed

			       #t)
			      ((and changed *time-to-exit*) ;; last sync
			       #t)
			      (else
			       #f))))
             (if (or dejunk do-cp)

		 (let* ((start-time (current-milliseconds))
			;; subdb is misnamed - should be dbdat (I think...)
			(subdb    (dbfile:open-db dbstruct run-id dbfile:db-init-proc))
			;;        (or (dbfile:get-subdb dbstruct run-id)
			;;            (dbfile:init-subdb dbstruct run-id dbfile:db-init-proc)))
			(mtdb      (dbr:subdb-mtdbdat subdb))
			;;
			;; BUG: -mrw- I think this next line is wrong. run-id should be the path to .megatest/<runid>.db
			;; 
			(tmpdb     (dbfile:open-db dbstruct run-id dbfile:db-init-proc)))
		   

		   (debug:print-info 2 *default-log-port* "delta syncing file: " srcfile ", time diff: " (- time1 time2) " seconds")

		   (if old2new
                       (begin
			 (if dejunk (db:clean-up run-id mtdb))
			 (db:sync-tables (db:sync-all-tables-list
					  dbstruct
					  (db:get-keys dbstruct))
					 #f mtdb tmpdb))
                       (begin
			 (if dejunk (db:clean-up run-id tmpdb))
			 (db:sync-tables (db:sync-all-tables-list dbstruct (db:get-keys dbstruct)) #f tmpdb mtdb)))


		   (hash-table-set! sync-durations (conc srcfile ".db") (- (current-milliseconds) start-time)))
		 (debug:print-info 2 *default-log-port* "skipping delta sync. " srcfile " is up to date"))))



	 dbfiles))


    data-synced))





;; Sync all changed db's
;;
(define (db:tmp->megatest.db-sync dbstruct run-id last-update)
  (let* ((subdbs (hash-table-values (dbr:dbstruct-subdbs dbstruct)))
	 (res    '()))
    (for-each

Modified dbfile.scm from [25f8271ef2] to [ace9ea7280].

222
223
224
225
226
227
228
229



230
231
232
233
234
235
236
237
238
239
    (hash-table-ref/default (dbr:dbstruct-subdbs dbstruct) dbfname #f)))

(define (dbfile:set-subdb dbstruct run-id subdb)
  (hash-table-set! (dbr:dbstruct-subdbs dbstruct) (dbfile:run-id->dbname run-id) subdb))

;; (define *dbfile:num-handles-in-use* 0)

;; Get/open a database



;;    if run-id => get run specific db
;;    if #f     => get main db
;;    if run-id is a string treat it as a filename
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
(define (dbfile:get-dbdat dbstruct run-id)
  (let* ((subdb (dbfile:get-subdb dbstruct run-id)))
    (if (stack-empty? (dbr:subdb-dbstack subdb))







|
>
>
>


|







222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    (hash-table-ref/default (dbr:dbstruct-subdbs dbstruct) dbfname #f)))

(define (dbfile:set-subdb dbstruct run-id subdb)
  (hash-table-set! (dbr:dbstruct-subdbs dbstruct) (dbfile:run-id->dbname run-id) subdb))

;; (define *dbfile:num-handles-in-use* 0)

;; Get/open a database.
;;
;;    NOTE: most usage should call dbfile:open-db to get a dbdat
;;
;;    if run-id => get run specific db
;;    if #f     => get main db
;;    if run-id is a string treat it as a filename - DON'T use this - we'll get rid of it.
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
(define (dbfile:get-dbdat dbstruct run-id)
  (let* ((subdb (dbfile:get-subdb dbstruct run-id)))
    (if (stack-empty? (dbr:subdb-dbstack subdb))