Megatest

          }
        }
      }
    }
  </script>
EOF
)

(define (tests:run-record->test-path run numkeys)
   (append (take (vector->list run) numkeys)
	   (list (vector-ref run (+ 1 numkeys)))))

;; (tests:create-html-tree "test-index.html")
;;
(define (tests:create-html-tree outf)
  (let* ((lockfile  (conc outf ".lock"))
	 (runs-to-process '()))
    (if (common:simple-file-lock lockfile)
	(let* ((linktree  (common:get-linktree))
	       (oup       (open-output-file outf))
	       (area-name (common:get-testsuite-name))
	       (keys      (rmt:get-keys))
	       (numkeys   (length keys))
	       (runsdat   (rmt:get-runs "%" #f #f (map (lambda (x)(list x "%")) keys)))
	       (header    (vector-ref runsdat 0))
	       (runs      (vector-ref runsdat 1))
	       (runtreedat (map (lambda (x)
				  (append (take (vector->list x) numkeys)
				  (tests:run-record->test-path x numkeys))
					  (list (vector-ref x (+ 1 numkeys))))) ;; gets the runname
				runs))
	       (runs-htree (common:list->htree runtreedat)))
	  (set! runs-to-process runs)
	  (s:output-new
	   oup
	   (s:html tests:css-jscript-block
		   (s:title "Summary for " area-name)

						      (lambda (x p)
							(let ((targpath (string-intersperse p "/"))
							      (runname  (car (reverse p))))
							  (s:a runname 'href (conc targpath "/runsummary.html"))))
							    ))))))
	  (close-output-port oup)
	  (common:simple-file-release-lock lockfile)
	  (for-each
	  ; (
	   (lambda (run)
	     (let* ((test-subpath (tests:run-record->test-path run numkeys))
		    (run-id       (db:get-value-by-header run header "id"))
		    (testdats     (rmt:get-tests-for-run
				   run-id "%" ;; testnamepatt
				   '()        ;; states
				   '()        ;; statuses
				   #f         ;; offset
				   #f         ;; num-to-get
				   #f         ;; hide/not-hide
				   #f         ;; sort-by
				   #f         ;; sort-order
				   #f         ;; 'shortlist                           ;; qrytype
                                   0         ;; last update
				   #f)))
	       (print "testdats: " testdats)))
	   runs)
	  #t)
	#f)))

;;   (let* ((outputfilename (conc "megatest-rollup-" test-name ".html"))
;; 	 (orig-dir       (current-directory))
;; 	 (logf-info      (rmt:test-get-logfile-info run-id test-name))
;; 	 (logf           (if logf-info (cadr logf-info) #f))