add CACHE-PLUGINS? option

This commit is contained in:
interp 2002-09-29 13:43:39 +00:00
parent 06c8b5ea5d
commit bfbeb49125
2 changed files with 39 additions and 19 deletions

View File

@ -93,6 +93,7 @@
httpd-logging ;HTTP-SYSLOG httpd-logging ;HTTP-SYSLOG
shift-reset ;SHIFT and RESET shift-reset ;SHIFT and RESET
conditions ;exception conditions ;exception
defrec-package ;define-record
scsh ;regexp et al. scsh ;regexp et al.
scheme scheme
) )
@ -106,6 +107,7 @@
send-html/finish send-html/finish
send-html send-html
form-query form-query
get-bindings
extract-bindings extract-bindings
extract-single-binding extract-single-binding
generate-input-field-name generate-input-field-name
@ -125,9 +127,11 @@
(define-structure servlets servlets-interface (define-structure servlets servlets-interface
(open servlet-handler/plugin (open servlet-handler/plugin
httpd-responses httpd-responses
httpd-request ; HTTP-URL:SEARCH
url ; REQUEST:URL
parse-html-forms parse-html-forms
sxml-to-html ;SXML->HTML sxml-to-html ; SXML->HTML
srfi-1 ;FILTER srfi-1 ; FILTER
sxml-tree-trans sxml-tree-trans
url url
httpd-request httpd-request

View File

@ -20,8 +20,15 @@
(return-continuation really-session-return-continuation (return-continuation really-session-return-continuation
set-session-return-continuation!)) set-session-return-continuation!))
(define-record options
(cache-plugins? #t))
(define *options* (make-options))
;(define *options-lock* (make-lock)) ; currently unused
(define *instance-table* (make-integer-table)) ; instance-id is index (define *instance-table* (make-integer-table)) ; instance-id is index
(define *instance-table-lock* (make-lock)) (define *instance-table-lock* (make-lock))
(define random (define random
(let* ((source (make-random-source)) (let* ((source (make-random-source))
(random-integer (begin (random-integer (begin
@ -190,10 +197,10 @@ You can try starting at the <A HREF=~a>beginning</a>."
(define (get-plugin-rt-structure plugin-name directory) (define (get-plugin-rt-structure plugin-name directory)
(let* ((full-plugin-name (absolute-file-name plugin-name directory)) (let* ((full-plugin-name (absolute-file-name plugin-name directory))
(load-plugin (load-plugin
(lambda () (lambda (cached?)
(with-fatal-error-handler* (with-fatal-error-handler*
(lambda (condition decline) (lambda (condition decline)
(release-lock *plugin-table-lock*) (if cached? (release-lock *plugin-table-lock*))
(decline)) (decline))
(lambda () (lambda ()
;; load-config-file does not care about cwd(?) ;; load-config-file does not care about cwd(?)
@ -202,23 +209,32 @@ You can try starting at the <A HREF=~a>beginning</a>."
;; plugin-structure to load must be named "plugin" ;; plugin-structure to load must be named "plugin"
(let ((plugin-structure (reify-structure 'plugin))) (let ((plugin-structure (reify-structure 'plugin)))
(load-structure plugin-structure) (load-structure plugin-structure)
(table-set! *plugin-table* full-plugin-name (if cached?
(cons plugin-structure (begin
(file-last-mod full-plugin-name))) (table-set! *plugin-table* full-plugin-name
;; only now the lock may be released (cons plugin-structure
(release-lock *plugin-table-lock*) (file-last-mod full-plugin-name)))
;; only now the lock may be released
(release-lock *plugin-table-lock*)))
plugin-structure)))))) plugin-structure))))))
(obtain-lock *plugin-table-lock*) (if (options:cache-plugins? *options*)
(let ((plugin (table-ref *plugin-table* full-plugin-name))) (begin
(if plugin ;; The lock is only obtained and released, if plugins are
(if (equal? (file-last-mod full-plugin-name) ;; cached. LOAD-PLUGIN gets the CACHED? parameter, so
(cdr plugin)) ;; nothing may happen, if in the meanwhile caching is turned
(begin ;; off.
(release-lock *plugin-table-lock*) (obtain-lock *plugin-table-lock*)
(car plugin)) (let ((plugin (table-ref *plugin-table* full-plugin-name)))
(load-plugin)) (if plugin
(load-plugin))))) (if (equal? (file-last-mod full-plugin-name)
(cdr plugin))
(begin
(release-lock *plugin-table-lock*)
(car plugin))
(load-plugin #t))
(load-plugin #t))))
(load-plugin #f))))
(define (reset-plugin-cache!) (define (reset-plugin-cache!)
(with-fatal-error-handler* (with-fatal-error-handler*