add CACHE-PLUGINS? option
This commit is contained in:
parent
06c8b5ea5d
commit
bfbeb49125
|
@ -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
|
||||||
|
|
|
@ -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*
|
||||||
|
|
Loading…
Reference in New Issue