From 4899ff0453fec28f65aaf5307b1bc607b4247091 Mon Sep 17 00:00:00 2001
From: interp <interp>
Date: Wed, 2 Oct 2002 23:45:35 +0000
Subject: [PATCH] bug removal; add data table to result output

---
 .../root/surflets/admin-profiling.scm         | 56 +++++++++++++------
 1 file changed, 39 insertions(+), 17 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 c80849f..bb580f7 100644
--- a/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm
+++ b/scheme/httpd/surflets/web-server/root/surflets/admin-profiling.scm
@@ -6,11 +6,16 @@
 	profiling
 	handle-fatal-error
 	httpd-responses
+	(subset srfi-1 (iota))
 	let-opt
 	)
   (begin
 
-    (define file-name (create-temp-file "servlet-profiling"))
+    ;; This uses the filesystem heavily to not influence the
+    ;; profiling. Note to get the resulting picture, gnuplot must be
+    ;; installed.
+
+    (define file-name #f)
     (define file-names-to-delete '())
     (define (add-file-name-to-delete! file-name)
       (set! file-names-to-delete (cons file-name file-names-to-delete)))
@@ -49,16 +54,18 @@
 				   "Delete files and reset profile state."))))
 			 (hr)
 			 (URL ,(return-address new-url) 
-			      "Return to main page leaving profile state untouched.")
+			      "Return to main page leaving files and state untouched.")
 			 (br)
 			 (URL ,(reset-return-address new-url)
-			      "Return to main page reseting profile-state"))))))
+			      "Return to main page removing files and reseting state."))))))
 	     (bindings (get-bindings req)))
 	(cond
 	 ((returned-via? new-profile-address bindings)
 	  (new-profile req))
 	 ((returned-via? result-address bindings)
-	  (result req))
+	  (if (zero? counter)
+	      (profile req "Now profiles created, currently. Select 'Create new profile' to create one.")
+	      (result req)))
 	 ((returned-via? reset-address bindings)
 	  (reset req))
 	 ((returned-via? return-address bindings)
@@ -78,17 +85,20 @@
 		(profile req "Please enter a file name of an existing executable.")))))))
 
     (define (new-profile req)
+      (format #t "profiling...~%")
       (profile-space file-name)
+      (format #t "profile recorded in ~s~%" file-name)
       (set! counter (+ 1 counter))
       (profile req (format #f "Profile #~a generated" counter)))
 
     (define (result req)
       (let ((results (profile-results file-name))
 	    (gnuplot-data-file-name (create-temp-file "servlet-profiling.data"))
-	    (picture-file (create-temp-file "servlet-profiling.picture")))
+	    (picture-file (create-temp-file "servlet-profiling.picture"))
+	    (get-total-bytes (lambda (space-info)
+			       (total-bytes (space-info-total space-info)))))
 	(write-gnuplot-data-file gnuplot-data-file-name 
-				 (lambda (space-info)
-				   (total-bytes (space-info-total space-info)))
+				 get-total-bytes
 				 results)
 	(let ((status 
 	       (run (,gnuplot -)
@@ -106,36 +116,48 @@ plot '~a' title 'Servlet Profiling ~a' with lines"
 	     (title "Servlet Administration -- Profiling Results")
 	     (body
 	      (h1 "Servlet-Administration")
-	      (h2 "Profiling")
-	      (h3 "Results")
-	      (p "This is the result of the profilings:")
+	      (h2 "Profiling Results")
+	      (h3 "Picture")
 	      ,(if (zero? status)
 		   `(image (@ (src ,picture-file)))
 		   `(p "An error occured while generating the profiling results picture."
 		       (br)
-		       "Are you sure, you have " (pre "gnuplot") 
-		       " installed at " (pre ,gnuplot) "?"))))))))
+		       "Are you sure, you have " (q "gnuplot") 
+		       " installed at " (q ,gnuplot) "?"))
+	      (hr)
+	      (h3 "Data")
+	      (table
+	       (tr (th "#") (th "Total bytes occupied"))
+	       ,@(map (lambda (num space-info)
+			`(tr (td ,(+ 1 num))
+			     (td ,(get-total-bytes space-info))))
+		      (iota (length results))
+		      results))))))))
 
     (define (reset req)
       (reset-profiling-state!)
       (profile req "Profiling state reseted."))
 
+    (define (delete-files)
+      (for-each delete-filesys-object file-names-to-delete))
+
     (define (reset-profiling-state!)
       (set! counter 0)
-      (for-each delete-filesys-object file-names-to-delete)
-      (delete-filesys-object file-name)
-      (set! file-name (create-temp-file "servlet-profiling"))
-      (set! file-names-to-delete '()))
+      (delete-files)
+      (set! file-name (absolute-file-name (create-temp-file "servlet-profiling")))
+      (set! file-names-to-delete (list file-name)))
 
     (define (reset-and-return-to-main-page req)
       (reset-profiling-state!)
-      (return-to-main-page req))    
+      (delete-files)
+      (return-to-main-page req))
 
     (define (return-to-main-page req)
       (send/finish (make-http-error-response http-status/moved-perm req
 					     "admin.scm" "admin.scm")))
 
     (define (main req)
+      (reset-profiling-state!)
       (profile req))
 
     ))
\ No newline at end of file