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
;; path string) while managing the SUrflet cache *SURFLET-TABLE*
;; (locking).
(define (get-surflet-rt-structure surflet-name directory)
(let* ((full-surflet-name (absolute-file-name surflet-name directory))
(load-surflet
(lambda (cached?)
(with-fatal-handler*
(lambda (condition decline)
(if cached? (release-lock *surflet-table-lock*))
(decline))
(lambda ()
;; load-config-file does not care about cwd(?)
;; --> absolute file name needed
(load-config-file full-surflet-name)
;; surflet-structure to load must be named "surflet"
(let ((surflet-structure (reify-structure 'surflet)))
(load-structure surflet-structure)
(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))
(define get-surflet-rt-structure
(let ((load-surflet
(lambda (full-surflet-name cached?)
(with-fatal-handler*
(lambda (condition decline)
(if cached? (release-lock *surflet-table-lock*))
(decline))
(lambda ()
;; load-config-file does not care about cwd(?)
;; --> absolute file name needed
(load-config-file full-surflet-name)
;; surflet-structure to load must be named "surflet"
(let ((surflet-structure (reify-structure 'surflet)))
(load-structure surflet-structure)
(if cached?
(begin
(release-lock *surflet-table-lock*)
(car surflet))
(load-surflet #t))
(load-surflet #t))))
(load-surflet #f))))
(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))))))
(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
;; Returns list of all loaded surflets (real path strings).