Megatest

Diff
Login

Differences From Artifact [8c84d35a2c]:

To Artifact [9bee706896]:


711
712
713
714
715
716
717
718



719
720
721
722
723
724

















725
726
727
728
729
730
731
732
733

734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768

769


770



771
772

773
774
775
776
777
778
779
780
781
;;  '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)) 



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


















    (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 0 *default-log-port* "destfile = " destfile))

	      (time1 (file-modification-time srcfile))

              (time2 (if (file-exists? destfile)
                         (begin
                            (debug:print-info 0 *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 (> time1 time2))

      (do-cp (cond
		      ((not (file-exists? destfile)) ;; shouldn't happen, but this might recover
		       (debug:print-info 0 *default-log-port* "File " destfile " not found. Copying "srcfile" to "destfile)
                       (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 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 0 *default-log-port* "delta syncing file: " srcfile ", time diff: " (- time1 time2) " seconds")

               (if old2new


		 (db:sync-tables (db:sync-all-tables-list dbstruct (db:get-keys dbstruct)) #f mtdb 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 0 *default-log-port* "skipping delta sync. " srcfile " is up to date")
          )
       )
     )
     dbfiles
    )
    data-synced
  )







|
>
>
>






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








|
>

<


|









|










|









>

>
>
|
>
>
>
|
|
>

|







711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755

756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
;;  '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: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 killservers
      (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))
      )
    )
    (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 (> time1 time2))

      (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)
                       (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 0 *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
  )
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536

1537

1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'
;;    b. If test dir gone, delete the test record
;; 2. Look at run records
;;    a. If have tests that are not deleted, set state='unknown'
;;    b. ....
;;
(define (db:clean-up dbdat)
  ;; (debug:print 0 *default-log-port* "WARNING: db clean up not fully ported to v1.60, cleanup action will be on megatest.db")
  (let* ((keep-record-age ( - (current-seconds) (common:hms-string->seconds (or (configf:lookup *configdat* "setup" "delete-record-age") "30d"))))
	 (db         (dbr:dbdat-dbh dbdat))
	 (count-stmt (sqlite3:prepare db "SELECT (SELECT count(id) FROM tests)+(SELECT count(id) FROM runs);"))
	(statements
	 (map (lambda (stmt)
		(sqlite3:prepare db stmt))
	      (list
	       ;; delete all tests that belong to runs that are 'deleted'
	       (conc "DELETE FROM tests WHERE run_id in (SELECT id FROM runs WHERE state='deleted') and last_update < " keep-record-age ";")
	       ;; delete all tests that are 'DELETED'
	       (conc "DELETE FROM tests WHERE state='DELETED' and last_update < " keep-record-age " ;")
	       ;; delete all tests that have no run
	       (conc "DELETE FROM tests WHERE run_id NOT IN (SELECT DISTINCT id FROM runs) and last_update < " keep-record-age "; ")
	       ;; delete all runs that are state='deleted'
	       (conc "DELETE FROM runs WHERE state='deleted' and last_update < " keep-record-age ";")
	       ;; delete empty runs
	       (conc "DELETE FROM runs WHERE id NOT IN (SELECT DISTINCT r.id FROM runs AS r INNER JOIN tests AS t ON t.run_id=r.id) and last_update < " keep-record-age ";")
	       ;; remove orphaned test_rundat entries
	       (conc "DELETE FROM test_rundat where test_id NOT IN (SELECT id FROM tests);")
	       ;; remove orphaned test_steps entries
	       (conc "DELETE FROM test_steps WHERE test_id NOT IN (SELECT id FROM tests);")
               ;; remove orphaned test_dat entries
	       (conc "DELETE FROM test_data WHERE test_id NOT IN (SELECT id FROM tests);")



	       ))))
    ;; (db:delay-if-busy dbdat)
    ;(debug:print-info 0 *default-log-port*  statements) 
    (sqlite3:with-transaction 
     db
     (lambda ()
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 *default-log-port* "Records count before clean: " tot))
			     count-stmt)
       (map sqlite3:execute statements)
       (sqlite3:for-each-row (lambda (tot)
			       (debug:print-info 0 *default-log-port* "Records count after  clean: " tot))
			     count-stmt)))
    (map sqlite3:finalize! statements)
    (sqlite3:finalize! count-stmt)
    ;; (db:find-and-mark-incomplete db)
    ;; (db:delay-if-busy dbdat)
    (sqlite3:execute db "VACUUM;")))

;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'







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







1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542













1543

1544





1545
1546
1547
1548

















1549
1550
1551
1552
1553
1554
1555
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'
;;    b. If test dir gone, delete the test record
;; 2. Look at run records
;;    a. If have tests that are not deleted, set state='unknown'
;;    b. ....
;;
(define (db:clean-up run-id dbdat)
  (debug:print 2 *default-log-port* "db:clean-up")















  (if run-id

    (db:clean-up-rundb dbdat)





    (db:clean-up-maindb dbdat)
  )
)



















;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
    (debug:print-info 11 *default-log-port* "db:get-runs END qrystr: " qrystr " target: " target " offset: " offset " limit: " count)
    res))

;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using inmem db)
;;
(define (db:get-changed-run-ids since-time)
  (let* ((dbdir      (db:dbfile-path)) ;; (configf:lookup *configdat* "setup" "dbdir"))
	 (alldbs     (glob (conc dbdir "/[0-9]*.db")))
	 (changed    (filter (lambda (dbfile)
			       (> (file-modification-time dbfile) since-time))
			     alldbs)))
    (delete-duplicates
     (map (lambda (dbfile)
	    (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile)))
	      (if res







|







1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
    (debug:print-info 11 *default-log-port* "db:get-runs END qrystr: " qrystr " target: " target " offset: " offset " limit: " count)
    res))

;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using inmem db)
;;
(define (db:get-changed-run-ids since-time)
  (let* ((dbdir      (db:dbfile-path)) ;; (configf:lookup *configdat* "setup" "dbdir"))
	 (alldbs     (glob (conc dbdir "/.megatest/[0-9]*.db")))
	 (changed    (filter (lambda (dbfile)
			       (> (file-modification-time dbfile) since-time))
			     alldbs)))
    (delete-duplicates
     (map (lambda (dbfile)
	    (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile)))
	      (if res
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364

4365
4366
4367

4368
4369










4370










4371










4372













4373


4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
	  waitons)
	 (delete-duplicates result)))))

;;======================================================================
;; To sync individual run
;;======================================================================
(define (db:get-run-record-ids dbstruct target run keynames test-patt)
(let ((backcons (lambda (lst item)(cons item lst))))
    (db:with-db
     dbstruct #f #f 
     (lambda (dbdat db)
        (let* ((keystr (string-intersperse 
		     (map (lambda (key val)
			    (conc key " like '" val "'"))
			  keynames 
			  (string-split target "/"))
		     " AND "))

         (run-qry (conc "SELECT id FROM runs  WHERE " keystr  " and runname='" run"'"))
         (test-qry (conc "SELECT id FROM tests WHERE run_id in (" run-qry ") and testname like '" test-patt "'")))
         (print run-qry)

         (print test-qry) 
	 `((runs       . ,(sqlite3:fold-row backcons '() db run-qry))










	   (tests      . ,(sqlite3:fold-row backcons '() db test-qry))










	   (test_steps . ,(sqlite3:fold-row backcons '() db (conc "SELECT id FROM test_steps WHERE test_id in (" test-qry ")")))










	   (test_data  . ,(sqlite3:fold-row backcons '() db (conc "SELECT id FROM test_data  WHERE test_id in (" test-qry ")" )))













	   ))))))



;;======================================================================
;; Just for sync, procedures to make sync easy
;;======================================================================

;; get an alist of run ids and test/run, test_step/run pairs changed since time since-time
;;   '((runs . (1 2 3 ...))(tests . ((5 . 1) (6 . 3) (6 . 2) (7 . 1)  ...
;;
(define (db:get-changed-record-ids dbstruct since-time)
  ;; no transaction, allow the db to be accessed between the big queries
  (let* ((backcons (lambda (lst item)(cons item lst)))
         (all_tests '())
         (all_test_steps '())
         (all_test_data '())

         (run_ids 
          (db:with-db dbstruct #f #f 
            (lambda (dbdat db)
              (sqlite3:fold-row backcons '() db "SELECT id FROM runs  WHERE last_update>=?" since-time))
          )
         )
         (run_stat_ids
          (db:with-db dbstruct #f #f 
            (lambda (dbdat db)
              (sqlite3:fold-row backcons '() db "SELECT id FROM run_stats  WHERE last_update>=?" since-time))
          )
         )
        )







|
|
|
|
|
|

|
|
|
>

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














<
|
<
<
<
<
<







4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427

4428





4429
4430
4431
4432
4433
4434
4435
	  waitons)
	 (delete-duplicates result)))))

;;======================================================================
;; To sync individual run
;;======================================================================
(define (db:get-run-record-ids dbstruct target run keynames test-patt)
   (let* ((backcons (lambda (lst item)(cons item lst)))
         (all_tests '())
         (all_test_steps '())
         (all_test_data '())
         (keystr (string-intersperse 
	                  (map (lambda (key val)
			    (conc key " like '" val "'"))
			     keynames 
			     (string-split target "/"))
		              " AND ")
         )
         (run-qry (conc "SELECT id FROM runs  WHERE " keystr  " and runname='" run"'"))
         (test-qry (conc "SELECT id FROM tests WHERE run_id in (" run-qry ") and testname like '" test-patt "'"))
         (run_ids 
           (db:with-db dbstruct #f #f 
             (lambda (dbdat db)
               (sqlite3:fold-row backcons '() db run-qry))
           )
         )
        )
        (for-each
          (lambda (run_id)
            (set! all_tests 
             (append 
               (map (lambda (x) (cons x run_id))                
                (db:with-db dbstruct run_id #f 
                  (lambda (dbdat db)
                    (sqlite3:fold-row backcons '() db (conc "SELECT id FROM tests WHERE run_id in (" run_id ") and testname like '" test-patt "'"))
                  )
                )
               ) all_tests
              )
            )
            (set! all_test_steps 
              (append 
                (map (lambda (x) (cons x run_id))
                  (db:with-db dbstruct run_id #f 
                    (lambda (dbdat db)
                      (sqlite3:fold-row backcons '() db (conc "SELECT id FROM test_steps  WHERE test_id in (" test-qry ")"))
                    )
                  )
                ) all_test_steps
              )
            )
            (set! all_test_data 
              (append 
                (map (lambda (x) (cons x run_id))
                  (db:with-db dbstruct run_id #f 
                    (lambda (dbdat db)
                      (sqlite3:fold-row backcons '() db (conc "SELECT id FROM test_data  WHERE test_id in (" test-qry ")"))
                    )
                  )
                ) all_test_data
              )
            )
          )
          run_ids
        )
      `((runs       . ,run_ids)
        (tests      . ,all_tests)
        (test_steps . ,all_test_steps)
        (test_data  . ,all_test_data)
       )
     
   )
)

;;======================================================================
;; Just for sync, procedures to make sync easy
;;======================================================================

;; get an alist of run ids and test/run, test_step/run pairs changed since time since-time
;;   '((runs . (1 2 3 ...))(tests . ((5 . 1) (6 . 3) (6 . 2) (7 . 1)  ...
;;
(define (db:get-changed-record-ids dbstruct since-time)
  ;; no transaction, allow the db to be accessed between the big queries
  (let* ((backcons (lambda (lst item)(cons item lst)))
         (all_tests '())
         (all_test_steps '())
         (all_test_data '())

         (run_ids (db:get-changed-run-ids since-time))





         (run_stat_ids
          (db:with-db dbstruct #f #f 
            (lambda (dbdat db)
              (sqlite3:fold-row backcons '() db "SELECT id FROM run_stats  WHERE last_update>=?" since-time))
          )
         )
        )