724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
|
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
|
-
+
-
+
+
+
|
((set-state-status)
(debug:print 2 "INFO: new state " (car state-status) ", new status " (cadr state-status))
(open-run-close db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f)))))
tests)))
;; remove the run if zero tests remain
(if (eq? action 'remove-runs)
(let ((remtests (db:get-tests-for-run db (db:get-value-by-header run header "id") #f #f '() '())))
(let ((remtests (db:get-tests-for-run db (db:get-value-by-header run header "id") #f #f '("DELETED") '("n/a") not-in: #t)))
(if (null? remtests) ;; no more tests remaining
(let* ((dparts (string-split lasttpath "/"))
(runpath (conc "/" (string-intersperse
(take dparts (- (length dparts) 1))
"/"))))
(debug:print 1 "Removing run: " runkey " " (db:get-value-by-header run header "runname"))
(debug:print 1 "Removing run: " runkey " " (db:get-value-by-header run header "runname") " and related record")
(db:delete-run db run-id)
;; This is a pretty good place to purge old DELETED tests
(db:delete-tests-for-run db run-id)
(db:delete-old-deleted-test-records db)
(db:set-var db "DELETED_TESTS" (current-seconds))
;; need to figure out the path to the run dir and remove it if empty
;; (if (null? (glob (conc runpath "/*")))
;; (begin
;; (debug:print 1 "Removing run dir " runpath)
;; (system (conc "rmdir -p " runpath))))
)))))
))
|