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

uncurry LOAD-SURFLET in GET-SURFLET-RT-STRUCTURE

This commit is contained in:
interp 2003-01-25 16:17:33 +00:00
parent 26fa1ca033
commit e934340fb5
1 changed files with 41 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
scheme/httpd/surflets/surflet-handler.scm
View File

@ -439,46 +439,48 @@
;; Returns SUrflet's RT-STRUCTURE indicated by SURFLET-NAME (a virtual ;; Returns SUrflet's RT-STRUCTURE indicated by SURFLET-NAME (a virtual
;; path string) while managing the SUrflet cache *SURFLET-TABLE* ;; path string) while managing the SUrflet cache *SURFLET-TABLE*
;; (locking). ;; (locking).
(define (get-surflet-rt-structure surflet-name directory) (define get-surflet-rt-structure
(let* ((full-surflet-name (absolute-file-name surflet-name directory)) (let ((load-surflet
(load-surflet (lambda (full-surflet-name cached?)
(lambda (cached?) (with-fatal-handler*
(with-fatal-handler* (lambda (condition decline)
(lambda (condition decline) (if cached? (release-lock *surflet-table-lock*))
(if cached? (release-lock *surflet-table-lock*)) (decline))
(decline)) (lambda ()
(lambda () ;; load-config-file does not care about cwd(?)
;; load-config-file does not care about cwd(?) ;; --> absolute file name needed
;; --> absolute file name needed (load-config-file full-surflet-name)
(load-config-file full-surflet-name) ;; surflet-structure to load must be named "surflet"
;; surflet-structure to load must be named "surflet" (let ((surflet-structure (reify-structure 'surflet)))
(let ((surflet-structure (reify-structure 'surflet))) (load-structure surflet-structure)
(load-structure surflet-structure) (if cached?
(if cached?
(begin
(table-set! *surflet-table* full-surflet-name
(cons surflet-structure
(file-last-mod full-surflet-name)))
;; only now the lock may be released
(release-lock *surflet-table-lock*)))
surflet-structure))))))
(if (options-cache-surflets?)
(begin
;; The lock is only obtained and released, if surflets are
;; cached. LOAD-SURFLET gets the CACHED? parameter, so
;; nothing may happen, if in the meanwhile caching is turned
;; off.
(obtain-lock *surflet-table-lock*)
(let ((surflet (table-ref *surflet-table* full-surflet-name)))
(if surflet
(if (equal? (file-last-mod full-surflet-name)
(cdr surflet))
(begin (begin
(release-lock *surflet-table-lock*) (table-set! *surflet-table* full-surflet-name
(car surflet)) (cons surflet-structure
(load-surflet #t)) (file-last-mod full-surflet-name)))
(load-surflet #t)))) ;; only now the lock may be released
(load-surflet #f)))) (release-lock *surflet-table-lock*)))
surflet-structure))))))
(lambda (surflet-name directory)
(let ((full-surflet-name (absolute-file-name surflet-name directory)))
(if (options-cache-surflets?)
(begin
;; The lock is only obtained and released, if surflets are
;; cached. LOAD-SURFLET gets the CACHED? parameter, so
;; nothing may happen, if in the meanwhile caching is turned
;; off.
(obtain-lock *surflet-table-lock*)
(let ((surflet (table-ref *surflet-table* full-surflet-name)))
(if surflet
(if (equal? (file-last-mod full-surflet-name)
(cdr surflet))
(begin
(release-lock *surflet-table-lock*)
(car surflet))
(load-surflet full-surflet-name #t))
(load-surflet full-surflet-name #t))))
(load-surflet full-surflet-name #f))))))
;;; GET-LOADED-SURFLETS ;;; GET-LOADED-SURFLETS
;; Returns list of all loaded surflets (real path strings). ;; Returns list of all loaded surflets (real path strings).