+ 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:
interp 2003-01-15 14:42:32 +00:00
parent 63c8867019
commit 02f9f60e99
1 changed files with 23 additions and 9 deletions

View File

@ -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
@ -141,6 +143,16 @@ plot '~a' title 'Servlet Profiling ~a' with lines"
(reset-and-return-to-main-page req)) (reset-and-return-to-main-page req))
(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)
@ -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")