From bf070b103698a51a891bb7da954fcef28ac48d73 Mon Sep 17 00:00:00 2001 From: interp Date: Wed, 19 Feb 2003 18:26:10 +0000 Subject: [PATCH] use 'convert' to create PNG profiling chart. --- .../root/surflets/admin-profiling.scm | 156 ++++++++++++++---- 1 file changed, 124 insertions(+), 32 deletions(-) diff --git a/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm b/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm index 8c4561e..c5c5000 100644 --- a/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm +++ b/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm @@ -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 - (run (,gnuplot -) + (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 )) \ No newline at end of file