scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm
View File

@ -50,11 +50,12 @@
(title "Servlet Administration -- Profiling")
(body (h1 "Serlvet Administration")
(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)
(p "Currently, there are " ,(state-counter) " profiles saved.")
(ul
(li (URL ,(new-profile-address new-url)
"Create new profile")
"Create new profile"))
(li (URL ,(result-address new-url)
"Show profile results")
(br)
@ -64,7 +65,7 @@
(p "This uses " (var "gnuplot") " that is searched at "
,input-field ,change-button)))
(li (URL ,(reset-address new-url)
"Delete files and reset profile state."))))
"Delete files and reset profile state.")))
(hr)
(URL ,(return-address new-url)
"Return to administration menu leaving files and state untouched.")
@ -109,9 +110,9 @@
(define (result req)
(let ((results (profile-results (state-file-name)))
(gnuplot-data-file-name (create-temp-file "servlet-profiling.data"))
(picture-file (string-append (create-temp-file
"../img/servlet-profiling.picture")
".pbm"))
(picture-file-name (create-empty-picture-file
"../img/servlet-profiling.picture"
".pbm"))
(get-total-bytes (lambda (space-info)
(total-bytes (space-info-total space-info))))
(return-address (make-address))
@ -125,13 +126,14 @@
set output '~a'
set size 0.7,0.7
plot '~a' title 'Servlet Profiling ~a' with lines"
picture-file
picture-file-name
gnuplot-data-file-name
(format-date "~c" (date))
)))))
(delete-file gnuplot-data-file-name)
(add-file-name-to-delete! picture-file)
(let* ((req (show-results status picture-file get-total-bytes results
(add-file-name-to-delete! picture-file-name)
(let* ((req (show-results status picture-file-name get-total-bytes results
return-address reset-return-address))
(bindings (get-bindings req)))
(cond
@ -141,6 +143,16 @@ plot '~a' title 'Servlet Profiling ~a' with lines"
(reset-and-return-to-main-page req))
(else
(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
return-address reset-return-address)
@ -152,8 +164,10 @@ plot '~a' title 'Servlet Profiling ~a' with lines"
(h1 "Servlet-Administration")
(h2 "Profiling Results")
(h3 "Picture")
(p "Note: The picture cannot be shown by your browser, currently. This will be fixed.")
,(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."
(br)
"Are you sure, you have " (q "gnuplot")