798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
|
(debug:print 2 "Removing directory with zero db references: " dir-to-remove)
(system (conc "rm -rf " dir-to-remove))
(hash-table-delete! dirs-to-remove dir-to-remove))
(debug:print 2 "Skipping removal of " dir-to-remove " for now as it still has references in the database")))))
(sort (hash-table-keys dirs-to-remove) (lambda (a b)(> (string-length a)(string-length b)))))
;; remove the run if zero tests remain
(let ((remtests (db-get-tests-for-run db (db:get-value-by-header run header "id"))))
(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"))
(db:delete-run db run-id)
|
|
|
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
|
(debug:print 2 "Removing directory with zero db references: " dir-to-remove)
(system (conc "rm -rf " dir-to-remove))
(hash-table-delete! dirs-to-remove dir-to-remove))
(debug:print 2 "Skipping removal of " dir-to-remove " for now as it still has references in the database")))))
(sort (hash-table-keys dirs-to-remove) (lambda (a b)(> (string-length a)(string-length b)))))
;; remove the run if zero tests remain
(let ((remtests (db-get-tests-for-run db (db:get-value-by-header run header "id") #f #f)))
(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"))
(db:delete-run db run-id)
|