(defun server (port &optional (background t))
(when (not *candle-dir*) (error "Need a candle dir"))
- (let
+ (let*
((data-dir (format nil "~Adata" *candle-dir*)))
(ensure-directories-exist *candle-dir*)
(ensure-directories-exist data-dir)
(lame-db:load-known-dbs data-dir)
- (sb-thread:make-thread
- (lambda ()
- (do () (nil)
- (progn
- (sleep (* 5 60))
- (lame-db:save-known-dbs data-dir))))
- :name "Save Thread")
(format t "Starting processor in ~(~A~) mode~%" *job-system*)
+ (start-save-thread data-dir)
(start-processor-thread)
(communication:start-listener port background)))
+(defun start-save-thread (data-dir)
+ (format t "Starting Save Thread~%")
+ (let*
+ ((mutex (sb-thread:make-mutex))
+ (waitq (sb-thread:make-waitqueue))
+ (active t)
+ (save-thread
+ (sb-thread:make-thread
+ (lambda ()
+ (loop
+ :while active
+ :do
+ (sb-thread:with-mutex (mutex)
+ (sb-thread:condition-wait waitq mutex)))
+ (lame-db:save-known-dbs data-dir))
+ :name "Save Thread")))
+ (sb-thread:make-thread
+ (lambda ()
+ (loop
+ (sleep (* 1 60))
+ (sb-thread:with-mutex (mutex)
+ (sb-thread:condition-broadcast waitq))))
+ :name "Save Thread Trigger")
+ (push
+ (lambda ()
+ (format t "Shutting down save thread~%")
+ (sb-thread:with-mutex (mutex)
+ (setf active nil)
+ (sb-thread:condition-broadcast waitq))
+ (sb-thread:join-thread save-thread))
+ sb-ext:*exit-hooks*)))
+
(defun add-project (name src)
(when
(not (cl-ppcre:scan "^[0-9A-Za-z-]*$" name))