Megatest

                            and :runname ,-testpatt and -itempatt
                            and -testpatt
  -rerun FAIL,WARN...     : re-run if called on a test that previously ran (nullified
                            if -keepgoing is also specified)
  -rebuild-db             : bring the database schema up to date
  -rollup                 : fill run (set by :runname)  with latest test(s) from
                            prior runs with same keys
  -lock                   : lock the run specified by target and runname as locked
                            which prevents -remove-runs from removing the run
  -update-meta            : update the tests metadata for all tests
  -env2file fname         : write the environment to fname.csh and fname.sh
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -archive                : archive tests, use -target, :runname, -itempatt and -testpatt
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname

			"-set-values"
			"-load-test-data"
			"-summarize-items"
		        "-gui"
			;; misc
			"-archive"
			"-repl"
			"-lock"
			;; queries
			"-test-paths" ;; get path(s) to a test, ordered by youngest first

			"-runall"    ;; run all tests
			"-remove-runs"
			"-keepgoing"
			"-usequeue"

	 (runs        (vector-ref rundat 1)))
    (debug:print 1 "Header: " header)
    (for-each
     (lambda (run)
       (let ((runkey (string-intersperse (map (lambda (k)
						(db:get-value-by-header run header (vector-ref k 0))) keys) "/"))
	     (dirs-to-remove (make-hash-table)))
	 (let* ((run-id    (db:get-value-by-header run header "id"))
		(run-state (db:get-value-by-header run header "state"))
		(tests     (if (not (equal? run-state "locked"))
			       (rdb:get-tests-for-run db (db:get-value-by-header run header "id") testpatt itempatt '() '())
			       '()))
		(lasttpath "/does/not/exist/I/hope"))
	   (if (not (equal? run-state "locked"))
	       (begin
		 (if (not (null? tests))
		     (begin
		       (debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname"))
		       (for-each
			(lambda (test)
			  (let* ((item-path (db:test-get-item-path test))
				 (test-name (db:test-get-testname test))
				 (run-dir   (db:test-get-rundir test)))
			    (debug:print 1 "  " (db:test-get-testname test) " id: " (db:test-get-id test) " " item-path)
			    (rdb:delete-test-records db (db:test-get-id test))
			    (if (> (string-length run-dir) 5) ;; bad heuristic but should prevent /tmp /home etc.
				(let ((fullpath run-dir)) ;; "/" (db:test-get-item-path test))))
				  (set! lasttpath fullpath)
				  (hash-table-set! dirs-to-remove fullpath #t)
				  ;; The following was the safe delete code but it was not being exectuted.
				  ;; (let* ((dirs-count (+ 1 (length keys)(length (string-split item-path "/"))))
				  ;;        (dir-to-rem (get-dir-up-n fullpath dirs-count))
				  ;;        (remainingd (string-substitute (regexp (conc "^" dir-to-rem "/")) "" fullpath))
				  ;;        (cmd (conc "cd " dir-to-rem "; rmdir -p " remainingd )))
				  ;;   (if (file-exists? fullpath)
				  ;;       (begin
				  ;;         (debug:print 1 cmd)
				  ;;         (system cmd)))
				  ;;   ))
				  ))))
			tests)))

		 ;; look though the dirs-to-remove for candidates for removal. Do this after deleting the records
		 ;; for each test in case we get killed. That should minimize the detritus left on disk
		 ;; process the dirs from longest string length to shortest
		 (for-each 
		  (lambda (dir-to-remove)
		    (if (file-exists? dir-to-remove)
			(let ((dir-in-db '()))
			  (sqlite3:for-each-row
			   (lambda (dir)
			     (set! dir-in-db (cons dir dir-in-db)))
			   db "SELECT rundir FROM tests WHERE rundir LIKE ?;" 
			   (conc "%" dir-to-remove "%")) ;; yes, I'm going to bail if there is anything like this dir in the db
			  (if (null? dir-in-db)
			      (begin
				(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 (rdb: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)
			 ;; 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))))
			 ))))
	       ))))
     runs)))

;;======================================================================
;; Routines for manipulating runs
;;======================================================================

;; Since many calls to a run require pretty much the same setup 

#!/usr/bin/env bash

export LINKSDIR=$1
export RUNSDIR=$2

if [ "x$LINKSDIR" == "x" ];then
   echo Usage: cleanup-links-dir /links/dir/path /runs/dir/path
   exit
fi


echo Removing dangling links....
for lnk in `find $LINKSDIR -type l ! -exec test -r {} \; -print`; do
  echo $lnk
  rm -f $lnk
done

echo Removing empty directories....
find $LINKSDIR -depth -type d -empty -print -exec rmdir {} \;