@@ -55,10 +55,108 @@
(include "js-path.scm")
(define (init-java-script-lib)
(set! *java-script-lib* (conc (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js"))
)
+
+
+;;======================================================================
+;; Stuff from http-transport
+;;======================================================================
+
+;;===============================================
+;; Java script
+;;===============================================
+(define (http-transport:show-jquery)
+ (let* ((data (tests:readlines *java-script-lib*)))
+(string-join data "\n")))
+
+;;======================================================================
+;; web pages
+;;======================================================================
+
+(define (http-transport:html-test-log $)
+ (let* ((run-id ($ 'runid))
+ (test-item ($ 'testname))
+ (parts (string-split test-item ":"))
+ (test-name (car parts))
+
+ (item-name (if (equal? (length parts) 1)
+ ""
+ (cadr parts))))
+ ;(print $)
+(tests:get-test-log run-id test-name item-name)))
+
+
+(define (http-transport:html-dboard $)
+ (let* ((page ($ 'page))
+ (oup (open-output-string))
+ (bdy "--------------------------")
+
+ (ret (tests:dynamic-dboard page)))
+ (s:output-new oup ret)
+ (close-output-port oup)
+
+ (set! bdy (get-output-string oup))
+ (conc "
Dashboard
" bdy "
" )))
+
+(define (http-transport:main-page)
+ (let ((linkpath (root-path)))
+ (conc "" (pathname-strip-directory *toppath*) "
"
+ ""
+ "Run area: " *toppath*
+ "Server Stats
"
+ (http-transport:stats-table)
+ "
"
+ (http-transport:runs linkpath)
+ "
"
+ ;; (http-transport:run-stats)
+ ""
+ )))
+
+(define (http-transport:stats-table)
+ (mutex-lock! *heartbeat-mutex*)
+ (let ((res
+ (conc ""
+ ;; "Max cached queries | " *max-cache-size* " |
"
+ "Number of cached writes | " *number-of-writes* " |
"
+ "Average cached write time | " (if (eq? *number-of-writes* 0)
+ "n/a (no writes)"
+ (/ *writes-total-delay*
+ *number-of-writes*))
+ " ms |
"
+ "Number non-cached queries | " *number-non-write-queries* " |
"
+ ;; "Average non-cached time | " (if (eq? *number-non-write-queries* 0)
+ ;; "n/a (no queries)"
+ ;; (/ *total-non-write-delay*
+ ;; *number-non-write-queries*))
+ " ms |
"
+ "Last access | " (seconds->time-string *db-last-access*) " |
"
+ "
")))
+ (mutex-unlock! *heartbeat-mutex*)
+ res))
+
+(define (http-transport:runs linkpath)
+ (conc "Runs
"
+ (string-intersperse
+ (let ((files (map pathname-strip-directory (glob (conc linkpath "/*")))))
+ (map (lambda (p)
+ (conc "" p "
"))
+ files))
+ " ")))
+
+#;(define (http-transport:run-stats)
+ (let ((stats (open-run-close db:get-running-stats #f)))
+ (conc ""
+ (string-intersperse
+ (map (lambda (stat)
+ (conc "" (car stat) " | " (cadr stat) " |
"))
+ stats)
+ " ")
+ "
")))
+
+
;; Call this one to do all the work and get a standardized list of tests
;; gets paths from configs and finds valid tests
;; returns hash of testname --> fullpath
;;