Megatest

Diff
Login

Differences From Artifact [d4dcfd72a3]:

To Artifact [c536b1d8e4]:


409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432



(define (db:all-db-sync dbstruct)
  (let* ((dbdat (db:open-db dbstruct #f db:initialize-main-db))
	 (data-synced       0) ;; count of changed records
    (tmp-area       (common:get-db-tmp-area))
    (dbfiles        (glob (conc tmp-area"/.megatest/*.db")))
    (sync-durations (make-hash-table))
    (no-sync-db        (db:open-no-sync-db)))
    (for-each
     (lambda (file) ;; tmp db file
       (debug:print-info 3 *default-log-port* "file: " file)
       (let* ((fname       (conc (pathname-file file) ".db")) ;; fname is tmp db file
              (wal-file (conc file "-wal"))
              (shm-file (conc file "-shm"))
	      (fulln       (conc *toppath*"/.megatest/"fname)) ;; fulln is nfs db name
              (wal-time     (if (file-exists? wal-file)             
			       (file-modification-time wal-file)
                               0))
              (shm-time     (if (file-exists? shm-file)             
			       (file-modification-time shm-file)
                               0))








|








|







409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432



(define (db:all-db-sync dbstruct)
  (let* ((dbdat (db:open-db dbstruct #f db:initialize-main-db))
	 (data-synced       0) ;; count of changed records
    (tmp-area       (common:get-db-tmp-area))
    (dbfiles        (glob (conc tmp-area"/" *dbdir* "/*.db")))
    (sync-durations (make-hash-table))
    (no-sync-db        (db:open-no-sync-db)))
    (for-each
     (lambda (file) ;; tmp db file
       (debug:print-info 3 *default-log-port* "file: " file)
       (let* ((fname       (conc (pathname-file file) ".db")) ;; fname is tmp db file
              (wal-file (conc file "-wal"))
              (shm-file (conc file "-shm"))
	      (fulln       (conc *toppath*"/" *dbdir* "/"fname)) ;; fulln is nfs db name
              (wal-time     (if (file-exists? wal-file)             
			       (file-modification-time wal-file)
                               0))
              (shm-time     (if (file-exists? shm-file)             
			       (file-modification-time shm-file)
                               0))

487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
    (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







|







487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
    (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* "/" *dbdir* "/*.db")) (glob (conc tmp-area "/" *dbdir* "/*.db"))))
    (keys (db:get-keys dbstruct))
    (sync-durations (make-hash-table)))


    (if killservers
      (begin
       	  (for-each
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
    )
    (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))
              ;; TODO: time1 and time2 need to take into account -wal and -shm files
	      (time1 (file-modification-time srcfile))
              (time2 (if (file-exists? destfile)
                         (begin
                            (debug:print-info 2 *default-log-port* "destfile " destfile " exists")







|
|







514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
    )
    (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 "/" *dbdir* "/" fname))
              (dest-directory  (conc dest-area "/" *dbdir* "/"))
              (dummy (debug:print-info 2 *default-log-port* "destfile = " destfile))
              (dummy2 (debug:print-info 2 *default-log-port* "dejunk = " dejunk))
              ;; TODO: time1 and time2 need to take into account -wal and -shm files
	      (time1 (file-modification-time srcfile))
              (time2 (if (file-exists? destfile)
                         (begin
                            (debug:print-info 2 *default-log-port* "destfile " destfile " exists")
1579
1580
1581
1582
1583
1584
1585


























































1586
1587
1588
1589
1590
1591
1592
		      qry)
		    qryvals)
	     (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=? AND state='deleted';" state status res)
	     res))) 
	(begin
	  (debug:print-error 0 *default-log-port* "Called without all necessary keys")
	  #f))))



























































;; replace header and keystr with a call to runs:get-std-run-fields
;;
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;; runpatts: patt1,patt2 ...
;;
(define (db:get-runs dbstruct runpatt count offset keypatts)







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







1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
		      qry)
		    qryvals)
	     (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=? AND state='deleted';" state status res)
	     res))) 
	(begin
	  (debug:print-error 0 *default-log-port* "Called without all necessary keys")
	  #f))))

;; called with run-id=#f so will operate on main.db
;;
(define (db:insert-run dbstruct run-id target runname run-meta)
  (let* ((keys (db:get-keys dbstruct))
     	 (runs (db:simple-get-runs dbstruct runname #f #f target #f))) ;; runpatt count offset target last-update
    ;; need to insert run based on target and runname
    (let* ((targvals (string-split target "/"))
	   (keystr   (string-intersperse keys ","))
	   (key?str  (string-intersperse (make-list (length targvals) "?") ","))
	   (qrystr   (conc "INSERT INTO runs (id,runname,"keystr") VALUES (?,?,"key?str")"))
	   (get-var  (lambda (db qrystr)
		       (let* ((res #f))
			 (sqlite3:for-each-row
			  (lambda row
			    (set res (car row)))
			  db qrystr run-id runname)
			 res))))
      (if (null? runs)
        (begin
	  (db:create-initial-run-record dbstruct run-id runname target)
        )
      )
      run-id)))

(define (db:create-initial-run-record dbstruct run-id runname target)	  
  (let* ((keys     (db:get-keys dbstruct))
     	 (targvals (string-split target "/"))
	 (keystr   (string-intersperse keys ","))
	 (key?str  (string-intersperse (make-list (length targvals) "?") ",")) ;; a string with the same length as targvals, where each element is "?" and interspersed with commas.
	 (qrystr   (conc "INSERT INTO runs (id,runname,"keystr") VALUES (?,?,"key?str")")))

    (db:with-db
     dbstruct #f #t ;; run-id writable
     (lambda (dbdat db)
       (apply sqlite3:execute db qrystr run-id runname targvals)))))

(define (db:insert-test dbstruct run-id test-rec)
  (let* ((testname  (alist-ref "testname" test-rec equal?))
	 (item-path (alist-ref "item_path" test-rec equal?))
	 (id        (db:get-test-id dbstruct run-id testname item-path))
	 (fieldvals (filter (lambda (x)(not (member (car x) '("id" "last_update")))) test-rec))
	 (setqry    (conc "UPDATE tests SET "(string-intersperse
					      (map (lambda (dat)
						     (conc (car dat)"=?"))
						   fieldvals)
					      ",")" WHERE id=?;"))
	 (insqry   (conc "INSERT INTO tests ("(string-intersperse (map (lambda (x) (car x)) fieldvals) ",")
			 ") VALUES ("(string-intersperse (make-list (length fieldvals) "?") ",")");")))
    ;; (debug:print 0 *default-log-port* "id: "id"\nset: "setqry"\ninsqry: "insqry)
    (db:with-db
     dbstruct
     run-id #t
     (lambda (dbdat db)
      ;; (if id
      ;;   (apply sqlite3:execute db setqry (append (map cdr fieldvals) (list id)))
	   (apply sqlite3:execute db insqry (map cdr fieldvals))
           ))))

;; replace header and keystr with a call to runs:get-std-run-fields
;;
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;; runpatts: patt1,patt2 ...
;;
(define (db:get-runs dbstruct runpatt count offset keypatts)
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666

1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
			     (if (number? count)
				 (conc " LIMIT " count)
				 "")
			     (if (number? offset)
				 (conc " OFFSET " offset)
				 "")))
	   )
    (debug:print-info 11 *default-log-port* "db:get-runs START qrystr: " qrystr " target: " target " offset: " offset " limit: " count)
    (db:with-db dbstruct #f #f
		(lambda (dbdat db)		
		  (sqlite3:for-each-row
		   (lambda (target id runname state status owner event_time)
		     (set! res (cons (make-simple-run target id runname state status owner event_time) res)))

		   db
		   qrystr
		   )))
    (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)
;;
;; NOTE: This DOESN'T (necessarily) get the real run ids, but the number of the <number>.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\\d)\\.db*" dbfile)))
             (if res







|




|
>



|













|







1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
			     (if (number? count)
				 (conc " LIMIT " count)
				 "")
			     (if (number? offset)
				 (conc " OFFSET " offset)
				 "")))
	   )
    (debug:print-info 11 *default-log-port* "db:simple-get-runs START qrystr: " qrystr " target: " target " offset: " offset " limit: " count)
    (db:with-db dbstruct #f #f
		(lambda (dbdat db)		
		  (sqlite3:for-each-row
		   (lambda (target id runname state status owner event_time)
		     (set! res (cons (make-simple-run target id runname state status owner event_time) res))
                   )
		   db
		   qrystr
		   )))
    (debug:print-info 11 *default-log-port* "db:simple-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)
;;
;; NOTE: This DOESN'T (necessarily) get the real run ids, but the number of the <number>.db!!






 (define (db:get-changed-run-ids since-time)
  (let* ((dbdir      (db:dbfile-path)) ;; (configf:lookup *configdat* "setup" "dbdir"))
        (alldbs     (glob (conc dbdir "/" *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\\d)\\.db*" dbfile)))
             (if res
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
         (changed_run_dbs (db:get-changed-run-ids since-time)) ;; gets the rundb numbers
         (all_run_ids 
          (db:with-db dbstruct #f #f 
            (lambda (dbdat db)
              (sqlite3:fold-row backcons '() db "SELECT id FROM runs"))
          )
         )
         (changed_run_ids (filter (lambda (run) (member (modulo run 100) changed_run_dbs)) all_run_ids))
         ;; TODO: couldn't we just use changed_run_ids for run_ids?
         (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))
          )
         )







|







4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
         (changed_run_dbs (db:get-changed-run-ids since-time)) ;; gets the rundb numbers
         (all_run_ids 
          (db:with-db dbstruct #f #f 
            (lambda (dbdat db)
              (sqlite3:fold-row backcons '() db "SELECT id FROM runs"))
          )
         )
         (changed_run_ids (filter (lambda (run) (member (modulo run (num-run-dbs)) changed_run_dbs)) all_run_ids))
         ;; TODO: couldn't we just use changed_run_ids for run_ids?
         (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))
          )
         )
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
	  #f
        ))))

;; sync for filesystem local db writes
;;
(define (db:run-lock-and-sync no-sync-db)
  (let* ((tmp-area       (common:get-db-tmp-area))
	 (dbfiles        (glob (conc tmp-area"/.megatest/*.db")))
	 (sync-durations (make-hash-table)))
    ;; (debug:print-info 0 *default-log-port* "lock-and-sync, dbfiles: "dbfiles)
    (for-each
     (lambda (file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/.megatest/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)







|





|







4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
	  #f
        ))))

;; sync for filesystem local db writes
;;
(define (db:run-lock-and-sync no-sync-db)
  (let* ((tmp-area       (common:get-db-tmp-area))
	 (dbfiles        (glob (conc tmp-area"/" *dbdir* "/*.db")))
	 (sync-durations (make-hash-table)))
    ;; (debug:print-info 0 *default-log-port* "lock-and-sync, dbfiles: "dbfiles)
    (for-each
     (lambda (file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/" *dbdir* "/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)