+ Add code to remove forgotten temporary file.
+ Add note about time of profiling. + Don't show profiling pictures anymore. The server can't show them anyway. Instead provide a link to the pbm file.
This commit is contained in:
parent
63c8867019
commit
02f9f60e99
|
@ -50,11 +50,12 @@
|
||||||
(title "Servlet Administration -- Profiling")
|
(title "Servlet Administration -- Profiling")
|
||||||
(body (h1 "Serlvet Administration")
|
(body (h1 "Serlvet Administration")
|
||||||
(h2 "Profiling")
|
(h2 "Profiling")
|
||||||
|
(p "Note: The operations performable via this interface take a while depending on the speed of the machine the server is running. Please be patient.")
|
||||||
(font (@ (color "red")) ,update-text)
|
(font (@ (color "red")) ,update-text)
|
||||||
(p "Currently, there are " ,(state-counter) " profiles saved.")
|
(p "Currently, there are " ,(state-counter) " profiles saved.")
|
||||||
(ul
|
(ul
|
||||||
(li (URL ,(new-profile-address new-url)
|
(li (URL ,(new-profile-address new-url)
|
||||||
"Create new profile")
|
"Create new profile"))
|
||||||
(li (URL ,(result-address new-url)
|
(li (URL ,(result-address new-url)
|
||||||
"Show profile results")
|
"Show profile results")
|
||||||
(br)
|
(br)
|
||||||
|
@ -64,7 +65,7 @@
|
||||||
(p "This uses " (var "gnuplot") " that is searched at "
|
(p "This uses " (var "gnuplot") " that is searched at "
|
||||||
,input-field ,change-button)))
|
,input-field ,change-button)))
|
||||||
(li (URL ,(reset-address new-url)
|
(li (URL ,(reset-address new-url)
|
||||||
"Delete files and reset profile state."))))
|
"Delete files and reset profile state.")))
|
||||||
(hr)
|
(hr)
|
||||||
(URL ,(return-address new-url)
|
(URL ,(return-address new-url)
|
||||||
"Return to administration menu leaving files and state untouched.")
|
"Return to administration menu leaving files and state untouched.")
|
||||||
|
@ -109,9 +110,9 @@
|
||||||
(define (result req)
|
(define (result req)
|
||||||
(let ((results (profile-results (state-file-name)))
|
(let ((results (profile-results (state-file-name)))
|
||||||
(gnuplot-data-file-name (create-temp-file "servlet-profiling.data"))
|
(gnuplot-data-file-name (create-temp-file "servlet-profiling.data"))
|
||||||
(picture-file (string-append (create-temp-file
|
(picture-file-name (create-empty-picture-file
|
||||||
"../img/servlet-profiling.picture")
|
"../img/servlet-profiling.picture"
|
||||||
".pbm"))
|
".pbm"))
|
||||||
(get-total-bytes (lambda (space-info)
|
(get-total-bytes (lambda (space-info)
|
||||||
(total-bytes (space-info-total space-info))))
|
(total-bytes (space-info-total space-info))))
|
||||||
(return-address (make-address))
|
(return-address (make-address))
|
||||||
|
@ -125,13 +126,14 @@
|
||||||
set output '~a'
|
set output '~a'
|
||||||
set size 0.7,0.7
|
set size 0.7,0.7
|
||||||
plot '~a' title 'Servlet Profiling ~a' with lines"
|
plot '~a' title 'Servlet Profiling ~a' with lines"
|
||||||
picture-file
|
picture-file-name
|
||||||
gnuplot-data-file-name
|
gnuplot-data-file-name
|
||||||
(format-date "~c" (date))
|
(format-date "~c" (date))
|
||||||
)))))
|
)))))
|
||||||
|
|
||||||
(delete-file gnuplot-data-file-name)
|
(delete-file gnuplot-data-file-name)
|
||||||
(add-file-name-to-delete! picture-file)
|
(add-file-name-to-delete! picture-file-name)
|
||||||
(let* ((req (show-results status picture-file get-total-bytes results
|
(let* ((req (show-results status picture-file-name get-total-bytes results
|
||||||
return-address reset-return-address))
|
return-address reset-return-address))
|
||||||
(bindings (get-bindings req)))
|
(bindings (get-bindings req)))
|
||||||
(cond
|
(cond
|
||||||
|
@ -142,6 +144,16 @@ plot '~a' title 'Servlet Profiling ~a' with lines"
|
||||||
(else
|
(else
|
||||||
(error "unexpected return address")))))))
|
(error "unexpected return address")))))))
|
||||||
|
|
||||||
|
(define create-empty-picture-file
|
||||||
|
(let ((lock (make-lock)))
|
||||||
|
(lambda (file-prefix file-suffix)
|
||||||
|
(obtain-lock lock)
|
||||||
|
(let* ((tmp-file-name (create-temp-file file-prefix))
|
||||||
|
(picture-file-name (string-append tmp-file-name file-suffix)))
|
||||||
|
(rename-file tmp-file-name picture-file-name)
|
||||||
|
(release-lock lock)
|
||||||
|
picture-file-name))))
|
||||||
|
|
||||||
(define (show-results status picture-file get-total-bytes results
|
(define (show-results status picture-file get-total-bytes results
|
||||||
return-address reset-return-address)
|
return-address reset-return-address)
|
||||||
(send-html/suspend
|
(send-html/suspend
|
||||||
|
@ -152,8 +164,10 @@ plot '~a' title 'Servlet Profiling ~a' with lines"
|
||||||
(h1 "Servlet-Administration")
|
(h1 "Servlet-Administration")
|
||||||
(h2 "Profiling Results")
|
(h2 "Profiling Results")
|
||||||
(h3 "Picture")
|
(h3 "Picture")
|
||||||
|
(p "Note: The picture cannot be shown by your browser, currently. This will be fixed.")
|
||||||
,(if (zero? status)
|
,(if (zero? status)
|
||||||
`(image (@ (src ,picture-file)))
|
; `(image (@ (src ,picture-file)))
|
||||||
|
`(URL ,picture-file "Profiling datagram.")
|
||||||
`(p "An error occured while generating the profiling results picture."
|
`(p "An error occured while generating the profiling results picture."
|
||||||
(br)
|
(br)
|
||||||
"Are you sure, you have " (q "gnuplot")
|
"Are you sure, you have " (q "gnuplot")
|
||||||
|
|
Loading…
Reference in New Issue