@@ -7,10 +7,11 @@
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(require-extension (srfi 18) extras tcp s11n)
+
(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras) ;; sqlite3
;; (import (prefix sqlite3 sqlite3:))
(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)
@@ -30,10 +31,12 @@
(declare (uses portlogger))
(declare (uses rmt))
(include "common_records.scm")
(include "db_records.scm")
+(include "js-path.scm")
+
(require-library stml)
(define (http-transport:make-server-url hostport)
(if (not hostport)
#f
(conc "http://" (car hostport) ":" (cadr hostport))))
@@ -108,10 +111,14 @@
((equal? (uri-path (request-uri (current-request)))
'(/ "jquery3.1.0.js"))
(send-response body: (http-transport:show-jquery)
headers: '((content-type application/javascript))))
((equal? (uri-path (request-uri (current-request)))
+ '(/ "test_log"))
+ (send-response body: (http-transport:html-test-log $)
+ headers: '((content-type text/HTML))))
+ ((equal? (uri-path (request-uri (current-request)))
'(/ "dashboard"))
(send-response body: (http-transport:html-dboard $)
headers: '((content-type text/HTML))))
(else (continue))))))))
(http-transport:try-start-server ipaddrstr start-port)))
@@ -532,30 +539,43 @@
;;===============================================
;; Java script
;;===============================================
(define (http-transport:show-jquery)
- (let* ((data (tests:readlines "/nfs/site/disks/ch_ciaf_disk023/fdk_gwa_disk003/pjhatwal/fdk/docs/qa-env-team/jquery-3.1.0.slim.min.js")))
+ (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)))
- ;(display ret oup)
(s:output-new oup ret)
(close-output-port oup)
(set! bdy (get-output-string oup))
- ;(debug:print-info 0 *default-log-port* "val: " bdy)
- (conc "Dashboard
" bdy "
" )))
+ (conc "Dashboard
" bdy "
" )))
(define (http-transport:main-page)
(let ((linkpath (root-path)))
(conc "" (pathname-strip-directory *toppath*) "
"
""