use 'convert' to create PNG profiling chart.
This commit is contained in:
interp
parent
2ff86dd73b
commit
bf070b1036
|
|
@ -34,12 +34,17 @@
|
|||
|
||||
;; Leave this global. Servers are running on a single system.
|
||||
(define gnuplot #f) ;; Set in main.
|
||||
(define convert #f)
|
||||
(define use-convert? #f)
|
||||
(define lock (make-lock))
|
||||
|
||||
(define (profile req . maybe-update-text)
|
||||
(let* ((update-text (:optional maybe-update-text ""))
|
||||
(input-field (make-text-input-field gnuplot '(@ (size 20))))
|
||||
(change-button (make-submit-button "Change"))
|
||||
(gnuplot-input-field (make-text-input-field gnuplot '(@ (size 20))))
|
||||
(gnuplot-change-button (make-submit-button "Change"))
|
||||
(convert-check-box (make-checkbox-input-field use-convert?))
|
||||
(convert-input-field (make-text-input-field convert '(@ (size 20))))
|
||||
(convert-change-button (make-submit-button "Change"))
|
||||
(new-profile-address (make-address))
|
||||
(result-address (make-address))
|
||||
(reset-address (make-address))
|
||||
|
|
@ -53,7 +58,7 @@
|
|||
(body (h1 "SUrflet 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)
|
||||
,(emph update-text)
|
||||
(p "Currently, there are " ,(state-counter) " profiles saved.")
|
||||
(ul
|
||||
(li (URL ,(new-profile-address new-url)
|
||||
|
|
@ -64,12 +69,25 @@
|
|||
(surflet-form
|
||||
,new-url
|
||||
POST
|
||||
(p "This uses " (var "gnuplot") " that is searched at "
|
||||
,input-field ,change-button (br)
|
||||
,(if (not (gnuplot-executable? gnuplot))
|
||||
'(font (@ (color "red"))
|
||||
"Note: There is no executable.")
|
||||
#f))))
|
||||
(table
|
||||
(@ (border 0))
|
||||
(thead)
|
||||
(tfoot)
|
||||
(tbody
|
||||
(@ (valign "top"))
|
||||
(tr
|
||||
(td)
|
||||
(td "This uses " (var "gnuplot") " that is searched at ")
|
||||
(td ,(executable-input gnuplot-input-field
|
||||
gnuplot
|
||||
gnuplot-change-button)))
|
||||
(tr
|
||||
(td ,convert-check-box)
|
||||
(td "This uses " (var "convert") " that is searched at ")
|
||||
(td ,(executable-input convert-input-field
|
||||
convert
|
||||
convert-change-button)))
|
||||
))))
|
||||
(li (URL ,(reset-address new-url)
|
||||
"Delete files and reset profile state.")))
|
||||
(hr)
|
||||
|
|
@ -94,17 +112,42 @@
|
|||
(return-to-main-page req))
|
||||
((returned-via? reset-return-address bindings)
|
||||
(reset-and-return-to-main-page req))
|
||||
(else
|
||||
(let ((new-gnuplot-location (input-field-value input-field bindings)))
|
||||
(if (gnuplot-executable? new-gnuplot-location)
|
||||
((input-field-binding gnuplot-change-button bindings)
|
||||
(let ((new-gnuplot-location (input-field-value gnuplot-input-field bindings)))
|
||||
(if (executable? new-gnuplot-location)
|
||||
(begin
|
||||
(set! gnuplot new-gnuplot-location)
|
||||
(profile req (format #f "Gnuplot is now searched at ~a." gnuplot)))
|
||||
(profile req "Please enter a file name of an existing executable.")))))))
|
||||
(profile req "Please enter a file name of an existing executable."))))
|
||||
((input-field-binding convert-change-button bindings)
|
||||
(let ((new-use-convert? (input-field-value convert-check-box bindings))
|
||||
(new-convert-location (input-field-value convert-input-field bindings)))
|
||||
(if (equal? use-convert? new-use-convert?)
|
||||
(if (executable? new-convert-location)
|
||||
(begin
|
||||
(set! convert new-convert-location)
|
||||
(profile req (format #f "Convert is now searched at ~a." convert)))
|
||||
(profile req "Please enter a file name of an existing executable."))
|
||||
(if (equal? new-convert-location convert)
|
||||
(begin
|
||||
(set! use-convert? new-use-convert?)
|
||||
(profile req (format #f "Convert is ~a used now."
|
||||
(if use-convert? "" "not"))))
|
||||
(begin
|
||||
(if (executable? new-convert-location)
|
||||
(begin
|
||||
(set! use-convert? new-use-convert?)
|
||||
(set! convert new-convert-location)
|
||||
(profile req (format #f "Convert (at ~a) is ~a used now."
|
||||
convert
|
||||
(if use-convert? "" "not"))))
|
||||
(profile req (format #f "Please enter a file name of an existing executable."))))))))
|
||||
(else
|
||||
(error "Unexpected choice.")))))
|
||||
|
||||
(define (gnuplot-executable? gnuplot-file-name)
|
||||
(and gnuplot-file-name
|
||||
(file-executable? gnuplot-file-name)))
|
||||
(define (executable? file-name)
|
||||
(and file-name
|
||||
(file-executable? file-name)))
|
||||
|
||||
(define (new-profile req)
|
||||
(let ((state (get-surflet-data)))
|
||||
|
|
@ -119,9 +162,12 @@
|
|||
(define (result req)
|
||||
(let ((results (profile-results (state-file-name)))
|
||||
(gnuplot-data-file-name (create-temp-file "surflet-profiling.data"))
|
||||
(picture-file-name (create-empty-picture-file
|
||||
(gnuplot-picture-name (create-empty-picture-file
|
||||
"../img/surflet-profiling.picture"
|
||||
".pbm"))
|
||||
(convert-picture-name (create-empty-picture-file
|
||||
"../img/surflet-profiling.picture"
|
||||
".png"))
|
||||
(get-total-bytes (lambda (space-info)
|
||||
(total-bytes (space-info-total space-info))))
|
||||
(return-address (make-address))
|
||||
|
|
@ -129,20 +175,36 @@
|
|||
(write-gnuplot-data-file gnuplot-data-file-name
|
||||
get-total-bytes
|
||||
results)
|
||||
(let ((status
|
||||
(let* ((gnuplot-status
|
||||
(run (,gnuplot -)
|
||||
(<< ,(format #f "set terminal pbm color
|
||||
set output '~a'
|
||||
set size 0.7,0.7
|
||||
plot '~a' title 'SUrflet Profiling ~a' with lines"
|
||||
picture-file-name
|
||||
gnuplot-picture-name
|
||||
gnuplot-data-file-name
|
||||
(format-date "~c" (date))
|
||||
)))))
|
||||
|
||||
))))
|
||||
(convert-status (and use-convert?
|
||||
(zero? gnuplot-status)
|
||||
(run (,convert ,gnuplot-picture-name
|
||||
,convert-picture-name)))))
|
||||
(format #t "use-convert? ~a gnuplot-status ~a convert-status ~a
|
||||
gnuplot-picture-name ~a
|
||||
convert-picture-name ~a~%"
|
||||
use-convert?
|
||||
gnuplot-status
|
||||
convert-status
|
||||
gnuplot-picture-name
|
||||
convert-picture-name)
|
||||
(delete-file gnuplot-data-file-name)
|
||||
(add-file-name-to-delete! picture-file-name)
|
||||
(let* ((req (show-results status picture-file-name get-total-bytes results
|
||||
(add-file-name-to-delete! gnuplot-picture-name)
|
||||
(if (and use-convert?
|
||||
(not (zero? convert-status)))
|
||||
(add-file-name-to-delete! convert-picture-name))
|
||||
(let* ((req (show-results gnuplot-status gnuplot-picture-name
|
||||
convert-status convert-picture-name
|
||||
get-total-bytes results
|
||||
return-address reset-return-address))
|
||||
(bindings (get-bindings req)))
|
||||
(cond
|
||||
|
|
@ -163,7 +225,9 @@ plot '~a' title 'SUrflet Profiling ~a' with lines"
|
|||
(release-lock lock)
|
||||
picture-file-name))))
|
||||
|
||||
(define (show-results status picture-file get-total-bytes results
|
||||
(define (show-results gnuplot-status gnuplot-picture-name
|
||||
convert-status convert-picture-name
|
||||
get-total-bytes results
|
||||
return-address reset-return-address)
|
||||
(send-html/suspend
|
||||
(lambda (new-url)
|
||||
|
|
@ -173,10 +237,15 @@ plot '~a' title 'SUrflet Profiling ~a' with lines"
|
|||
(h1 "SUrflet-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)))
|
||||
`(URL ,picture-file "Profiling datagram.")
|
||||
,(if (zero? gnuplot-status)
|
||||
(if use-convert?
|
||||
(if (zero? convert-status)
|
||||
`(image (@ (src ,convert-picture-name)))
|
||||
`(p "An error occured while generating the profiling results"
|
||||
" chart with convert (" ,convert ")."
|
||||
" Anyway, you can download the "
|
||||
(URL ,gnuplot-picture-name "raw profiling chart") "."))
|
||||
`(URL ,gnuplot-picture-name "Profiling chart."))
|
||||
`(p "An error occured while generating the profiling results picture."
|
||||
(br)
|
||||
"Are you sure, you have " (q "gnuplot")
|
||||
|
|
@ -232,16 +301,39 @@ plot '~a' title 'SUrflet Profiling ~a' with lines"
|
|||
|
||||
(define (main req)
|
||||
;; We'll fill this out soon.
|
||||
(set! gnuplot (search-gnuplot))
|
||||
(set! gnuplot (search-executable "gnuplot"))
|
||||
(if (string=? gnuplot "")
|
||||
(begin
|
||||
(set! use-convert? #f)
|
||||
(set! convert ""))
|
||||
(begin
|
||||
(set! convert (search-executable "convert"))
|
||||
(if (string=? convert "")
|
||||
(set! use-convert? #f)
|
||||
(set! use-convert? #t))))
|
||||
(set-surflet-data! (make-state #f #f 0))
|
||||
(reset-profiling-state!)
|
||||
;; Remove state files if user did not do it.
|
||||
(add-finalizer! (get-surflet-data) delete-files)
|
||||
(profile req))
|
||||
|
||||
(define (search-gnuplot)
|
||||
(receive (status ports) (run/collecting (1) (which gnuplot))
|
||||
(define (search-executable exec-name)
|
||||
(receive (status ports) (run/collecting (1) (which ,exec-name))
|
||||
(if (zero? status)
|
||||
(read-line ports)
|
||||
"")))
|
||||
|
||||
(define (emph text)
|
||||
`(font (@ (color "red")) ,text))
|
||||
|
||||
(define (executable-input input-field exec-name change-button)
|
||||
`(table
|
||||
(@ (border 0))
|
||||
(tr (td ,input-field) (td ,change-button))
|
||||
,(if (executable? exec-name)
|
||||
#f
|
||||
`(tr (td (@ (colspan 2))
|
||||
,(emph "Note: There is no executable."))))))
|
||||
|
||||
;; TODO: check `where' tool
|
||||
))
|
||||
Loading…
Reference in New Issue