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

Get rid of a bug. Filtering of instances is disabled to achieve this.

This commit is contained in:
interp 2002-11-03 18:15:53 +00:00
parent 1374c4a8a6
commit 2ab106745a
1 changed files with 15 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
scheme/httpd/surflets/web-server/root/surflets/admin-servlets.scm
View File

@ -87,7 +87,7 @@
(URL ,(make-callback return-to-main-page) "Return to administration menu.") (URL ,(make-callback return-to-main-page) "Return to administration menu.")
(br) (br)
(URL "/" "Return to main menu."))) (URL "/" "Return to main menu.")))
(actions '("unload" "unload all" "view instances"))) (actions '("unload" "unload all")))
(if (null? loaded-servlets) (if (null? loaded-servlets)
(send-html `(html (title ,title) (body ,header ,(no-servlets) ,footer))) (send-html `(html (title ,title) (body ,header ,(no-servlets) ,footer)))
(receive (action selected-servlets) (receive (action selected-servlets)
@ -118,19 +118,6 @@
((string=? action "unload all") ((string=? action "unload all")
(unload-servlets outdated? loaded-servlets) (unload-servlets outdated? loaded-servlets)
(show-servlets 'no-req "Servlets unloaded.")) (show-servlets 'no-req "Servlets unloaded."))
((string=? action "view instances")
(format #t "~s~%" selected-servlets)
(let* ((path-stripped-selected-servlets
(map remove-servlet-path selected-servlets))
(selected-instances
(filter (lambda (instance-pair)
(member (instance-servlet-name (cdr instance-pair))
path-stripped-selected-servlets))
(get-instances))))
;; this does not return
(real-instances (sort-list! selected-instances
instance-servlet-name<?)
"")))
(else (else
(error "unknown action" action))))))))) (error "unknown action" action)))))))))
@ -158,7 +145,6 @@
(URL "admin.scm" "Go back to main page."))) (URL "admin.scm" "Go back to main page.")))
(define (show-instances req . maybe-update-text) (define (show-instances req . maybe-update-text)
(format #t "show-instances called with req ~s~%" req)
(let* ((update-text (:optional maybe-update-text "")) (let* ((update-text (:optional maybe-update-text ""))
(current-instances (sort-list! (get-instances) instance-servlet-name<?))) (current-instances (sort-list! (get-instances) instance-servlet-name<?)))
(real-instances current-instances update-text))) (real-instances current-instances update-text)))
@ -194,7 +180,7 @@
actions actions
footer) footer)
(if (not action) (if (not action)
(real-instances current-instances "Choose an action.") (show-instances current-instances "Choose an action.")
(let ((new-update-text (let ((new-update-text
(cond (cond
((string=? action "kill") ((string=? action "kill")
@ -218,7 +204,7 @@
(show-continuations selected-instances)))) (show-continuations selected-instances))))
(else (else
(error "unknown action" action))))) (error "unknown action" action)))))
(real-instances current-instances new-update-text))))))) (show-instances current-instances new-update-text)))))))
@ -230,7 +216,7 @@
" this page or go back to the " " this page or go back to the "
(URL ,(make-callback show-instances) "instance table overview.")))) (URL ,(make-callback show-instances) "instance table overview."))))
(define (no-more-than-one-instance title header1) (define (no-more-than-one-instance title header1 instances)
(send-html (send-html
`(html (title ,title) `(html (title ,title)
(body (h1 "Servlet Administration") (body (h1 "Servlet Administration")
@ -240,7 +226,16 @@
(p "You may choose to go back to the " (p "You may choose to go back to the "
(URL ,(make-callback show-instances) (URL ,(make-callback show-instances)
"instances administration page") "instances administration page")
" where you can select one instance."))))) " where you can select one instance"
" or select one instance from your chosen instances:" (br)
(ul
,@(map (lambda (instance)
`(li (URL ,(make-callback
(lambda (req)
(show-continuations (list instance))))
,(instance-servlet-name (cdr instance))
" (" ,(car instance) ")")))
instances)))))))
(define (continuation-id<? entry1 entry2) (define (continuation-id<? entry1 entry2)
(< (car entry1) (car entry2))) (< (car entry1) (car entry2)))
@ -249,7 +244,7 @@
(let ((title "Servlet Adminstration - Continuations") (let ((title "Servlet Adminstration - Continuations")
(header1 '(h1 "Servlet Administration"))) (header1 '(h1 "Servlet Administration")))
(if (not (= 1 (length instances))) (if (not (= 1 (length instances)))
(no-more-than-one-instance title header1) (no-more-than-one-instance title header1 instances)
(let* ((instance-pair (car instances)) (let* ((instance-pair (car instances))
(instance-id (car instance-pair)) (instance-id (car instance-pair))
(instance-entry (cdr instance-pair)) (instance-entry (cdr instance-pair))