Megatest

Changes On Branch 26b65d88c76a8a98
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Unified Diff

Changes In Branch v1.80-revolution-deleted-records-cleanup Excluding Merge-Ins

This is equivalent to a diff from b229b3f7b0 to 26b65d88c7

2023-12-14
15:52
Merged opportunistic deletion of DELETED tests. check-in: a6497fd596 user: mrwellan tags: v1.80-revolution
15:28
Added opportunistic old DELETED records removal Leaf check-in: 26b65d88c7 user: mrwellan tags: v1.80-revolution-deleted-records-cleanup
15:11
Fixed cleanup-db to do both nfs and tmp dbs. check-in: 05132c1b5d user: mmgraham tags: v1.80-revolution
08:30
Merged forward changes for ck5 build Leaf check-in: 23b682828e user: mrwellan tags: v1.80-revolution-ck5-2
2023-12-13
15:49
Improved dashboard performance check-in: b229b3f7b0 user: mrwellan tags: v1.80-revolution
13:06
Moved the addition of /.mtdb for db paths up to db:setup, and removed it from other places. Initial implementation of -cleanup-db. check-in: b9d51df3ee user: mmgraham tags: v1.80-revolution

Modified db.scm from [d74d37ec7f] to [d5c83ed16d].

︙︙
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320


2321
2322
2323
2324
2325
2326
2327
2328












2329
2330
2331
2332
2333
2334
2335

  (db:general-call dbstruct run-id 'delete-test-data-records (list test-id))
  (db:with-db
   dbstruct run-id #t
   (lambda (dbdat db)
     (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id))))

;; 
(define (db:delete-old-deleted-test-records dbstruct)
  (let ((targtime (- (current-seconds)
		     (or (configf:lookup-number *configdat* "setup" "keep-deleted-records")
			 (* 30 24 60 60))))) ;; one month in the past
    (db:with-db
     dbstruct
     0


     #t
     (lambda (dbdat db)
       (sqlite3:with-transaction
	db
	(lambda ()
	  (sqlite3:execute db "DELETE FROM test_steps WHERE test_id IN (SELECT id FROM tests WHERE state='DELETED' AND event_time<?);" targtime)
	  (sqlite3:execute db "DELETE FROM test_data WHERE test_id IN (SELECT id FROM tests WHERE state='DELETED' AND event_time<?);" targtime)
	  (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED' AND event_time<?;" targtime)))))))













;; set tests with state currstate and status currstatus to newstate and newstatus
;; use currstate = #f and or currstatus = #f to apply to any state or status respectively
;; WARNING: SQL injection risk. NB// See new but not yet used "faster" version below
;;
;;  AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
;;  (debug:print 0 *default-log-port* "QRY: " qry)








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








2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317

2318

2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347

  (db:general-call dbstruct run-id 'delete-test-data-records (list test-id))
  (db:with-db
   dbstruct run-id #t
   (lambda (dbdat db)
     (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id))))

;; 
(define (db:delete-old-deleted-test-records dbstruct run-id)
  (let* ((targtime (- (current-seconds)
		      (or (configf:lookup-number *configdat* "setup" "keep-deleted-records")
			  (* 7 24 60 60)))) ;; cleanup if over one week old

	 (mtdbfile (dbmod:run-id->full-dbfname dbstruct run-id))

	 (qry1     "DELETE FROM test_steps WHERE test_id IN (SELECT id FROM tests WHERE state='DELETED' AND event_time<?);")
	 (qry2     "DELETE FROM test_data WHERE test_id IN (SELECT id FROM tests WHERE state='DELETED' AND event_time<?);")
	 (qry3     "DELETE FROM tests WHERE state='DELETED' AND event_time<?;")
	 (delproc  (lambda (db)
		     (sqlite3:with-transaction
		      db
		      (lambda ()
			(sqlite3:execute db qry1 targtime)
			(sqlite3:execute db qry2 targtime)
			(sqlite3:execute db qry3 targtime))))))
    ;; first the /tmp db
    (db:with-db
     dbstruct
     run-id
     #t
     (lambda (dbdat db)
       (delproc db)))
    (if (and (file-exists? mtdbfile)
	     (file-write-access? mtdbfile))
	(let* ((db (sqlite3:open-database mtdbfile)))
	  (delproc db)
	  (sqlite3:finalize! db)))))

;; set tests with state currstate and status currstatus to newstate and newstatus
;; use currstate = #f and or currstatus = #f to apply to any state or status respectively
;; WARNING: SQL injection risk. NB// See new but not yet used "faster" version below
;;
;;  AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
;;  (debug:print 0 *default-log-port* "QRY: " qry)
︙︙

Modified dbmod.scm from [99ee74ba02] to [8d730c1bee].

︙︙
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

	 (dbdir    (conc areapath"/.mtdb")))
    (if (and (file-write-access? areapath)
	     (not (file-exists? dbdir)))
	(create-directory dbdir))
    dbdir))

(define (dbmod:run-id->full-dbfname dbstruct run-id)
  (conc (dbmod:get-dbdir dbstruct

			 run-id

			 )"/"(dbmod:run-id->dbfname run-id)))

;;======================================================================
;; Read-only cachedb cached direct from disk method
;;======================================================================

(define *dbmod:nfs-db-handles* (make-hash-table)) ;; dbfname -> dbstruct









|
<
<
<
|








57
58
59
60
61
62
63
64



65
66
67
68
69
70
71
72

	 (dbdir    (conc areapath"/.mtdb")))
    (if (and (file-write-access? areapath)
	     (not (file-exists? dbdir)))
	(create-directory dbdir))
    dbdir))

(define (dbmod:run-id->full-dbfname dbstruct run-id)
  (conc (dbmod:get-dbdir dbstruct)



	"/"(dbmod:run-id->dbfname run-id)))

;;======================================================================
;; Read-only cachedb cached direct from disk method
;;======================================================================

(define *dbmod:nfs-db-handles* (make-hash-table)) ;; dbfname -> dbstruct
︙︙

Modified rmt.scm from [99d2ba2df9] to [c6584b1eb1].

︙︙
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495


(define (rmt:delete-run run-id)
  (rmt:send-receive 'delete-run #f (list run-id)))

(define (rmt:update-run-stats run-id stats)
  (rmt:send-receive 'update-run-stats #f (list run-id stats)))

(define (rmt:delete-old-deleted-test-records)
  (rmt:send-receive 'delete-old-deleted-test-records #f '()))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:simple-get-runs runpatt count offset target last-update)
  (rmt:send-receive 'simple-get-runs #f (list runpatt count offset target last-update)))









|
|








480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495


(define (rmt:delete-run run-id)
  (rmt:send-receive 'delete-run #f (list run-id)))

(define (rmt:update-run-stats run-id stats)
  (rmt:send-receive 'update-run-stats #f (list run-id stats)))

(define (rmt:delete-old-deleted-test-records run-id)
  (rmt:send-receive 'delete-old-deleted-test-records run-id (list run-id)))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:simple-get-runs runpatt count offset target last-update)
  (rmt:send-receive 'simple-get-runs #f (list runpatt count offset target last-update)))
︙︙

Modified runs.scm from [66517b0c3e] to [a4e834ba4f].

︙︙
2432
2433
2434
2435
2436
2437
2438


2439
2440
2441
2442
2443
2444
2445

	       (begin
		 (case action
                   ((kill-runs)
                    (tasks:kill-runner target run-name "%")
                    (debug:print 1 *default-log-port* "Killing tests for run: " runkey " " (db:get-value-by-header run header "runname"))
                    )
		   ((remove-runs)


		    ;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
		    ;; seek and kill in flight -runtests with % as testpatt here
		    ;; (if (equal? testpatt "%")
		    (tasks:kill-runner target run-name testpatt)
		    ;; (debug:print 0 *default-log-port* "not attempting to kill any run launcher processes as testpatt is " testpatt))
		    (debug:print 1 *default-log-port* "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((set-state-status)








>
>








2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447

	       (begin
		 (case action
                   ((kill-runs)
                    (tasks:kill-runner target run-name "%")
                    (debug:print 1 *default-log-port* "Killing tests for run: " runkey " " (db:get-value-by-header run header "runname"))
                    )
		   ((remove-runs)
		    ;; use this location to cleanup old DELETED records? No. See below for same call
		    ;; (rmt:delete-old-deleted-test-records run-id)
		    ;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))
		    ;; seek and kill in flight -runtests with % as testpatt here
		    ;; (if (equal? testpatt "%")
		    (tasks:kill-runner target run-name testpatt)
		    ;; (debug:print 0 *default-log-port* "not attempting to kill any run launcher processes as testpatt is " testpatt))
		    (debug:print 1 *default-log-port* "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((set-state-status)
︙︙
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736

                    (debug:print 2 *default-log-port* "run-paths-hash: " (hash-table-keys run-paths-hash))

                    (debug:print 1 *default-log-port* "Removing target " target "run: " run-name)
                    (if (not keep-records)
                      (begin
                        (debug:print 1 *default-log-port* "Removing DB records for the run.")
                        (rmt:delete-run run-id)
                        (rmt:delete-old-deleted-test-records))
                    )
                    (if (not (equal?  linkspath "/does/not/exist/I"))
	               (begin 
                         (debug:print 1 *default-log-port* "Recursively removing links dir " linkspath)
                         (runs:recursive-delete-with-error-msg linkspath)))

                   (for-each (lambda(runpath)








|








2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738

                    (debug:print 2 *default-log-port* "run-paths-hash: " (hash-table-keys run-paths-hash))

                    (debug:print 1 *default-log-port* "Removing target " target "run: " run-name)
                    (if (not keep-records)
                      (begin
                        (debug:print 1 *default-log-port* "Removing DB records for the run.")
                        (rmt:delete-run run-id)
                        (rmt:delete-old-deleted-test-records run-id))
                    )
                    (if (not (equal?  linkspath "/does/not/exist/I"))
	               (begin 
                         (debug:print 1 *default-log-port* "Recursively removing links dir " linkspath)
                         (runs:recursive-delete-with-error-msg linkspath)))

                   (for-each (lambda(runpath)
︙︙

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