1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
|
(lambda (run)
(let ((target (simple-run-target run)))
(hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
runs)))
targets)
res-ht))
(define (runs:get-all-but-most-recent-n-per-target target-patts runpatt num-to-keep)
(let ((runs-ht (runs:get-hash-by-target target-patts runpatt)))
(for-each
(lambda (target)
(let* ((runs (hash-table-ref runs-ht target))
(sorted (sort runs (lambda (a b)(> (simple-run-event_time a)(simple-run-event_time b)))))
(to-remove (if (> (length sorted) num-to-keep)
(take sorted (- (length sorted) num-to-keep))
'())))
(print "Sorted: " (map simple-run-event_time sorted))
(print "Remove: " (map simple-run-event_time to-remove))))
(hash-table-keys runs-ht))
runs-ht))
;; Remove runs
;; fields are passing in through
;; action:
;; 'remove-runs
;; 'set-state-status
;;
|
>
>
>
>
|
>
|
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
|
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
|
(lambda (run)
(let ((target (simple-run-target run)))
(hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
runs)))
targets)
res-ht))
;; delete runs older than X (weeks, days, months years etc.)
;; delete redundant runs within a target - N is the input
;; delete redundant runs within a target IFF older than given date/time AND keep at least N
;;
(define (runs:remove-all-but-last-n-runs-per-target target-patts runpatt num-to-keep #!key (actions '(print)))
(let ((runs-ht (runs:get-hash-by-target target-patts runpatt)))
(for-each
(lambda (target)
(let* ((runs (hash-table-ref runs-ht target))
(sorted (sort runs (lambda (a b)(> (simple-run-event_time a)(simple-run-event_time b)))))
(to-remove (let* ((len (length sorted))
(trim-amt (- len num-to-keep)))
(if (> trim-amt 0)
(take sorted trim-amt)
'()))))
(hash-table-set! runs-ht target to-remove)
(print target ":")
(for-each
(lambda (run)
(let ((remove (member run to-remove (lambda (a b)
(eq? (simple-run-id a)
(simple-run-id b))))))
(for-each
(lambda (action)
(case action
((print)
(print " " (simple-run-runname run)
" " (time->string (seconds->local-time (simple-run-event_time run)) "WW%V.%u %H:%M:%S")
" " (if remove "REMOVE" "")))
((remove)
(print "megatest -remove-runs -target " target " -runname " (simple-run-runname run) " -testpatt %"))))
actions)))
sorted)))
;; (print "Sorted: " (map simple-run-event_time sorted))
;; (print "Remove: " (map simple-run-event_time to-remove))))
(hash-table-keys runs-ht))
runs-ht))
;; (define (runs:remove-all-but-last-n-runs-per-target target-patts runpatt num-to-keep)
;; (let ((data (runs:get-all-but-most-recent-n-per-target target-patts runpatt num-to-keep)))
;; (for-each
;; (lambda (target)
;; (let ((runs-to-remove (hash-table-ref data target )))
;; (for-each
;; (lambda (run)
;; (print "megatest -remove-runs -target " target " -runname " (simple-run-runname run) " -testpatt %"))
;; runs-to-remove)))
;; (hash-table-keys data))))
;; Remove runs
;; fields are passing in through
;; action:
;; 'remove-runs
;; 'set-state-status
;;
|