Clozure CL 中长时间运行的应用程序的应用程序交付答案

【问题标题】：Application Delivery of long running application in Clozure CLClozure CL 中长时间运行的应用程序的应用程序交付
【发布时间】：2014-10-31 00:04:45
【问题描述】：

应用程序交付的所有基本示例都展示了如何用您自己的函数替换顶层函数。一旦该功能完成，应用程序就会退出。我想知道为长时间运行的应用程序创建顶级函数的最佳方法是什么。我的代码是

(ql:quickload :my-app)

(defun main ()
  (swank:create-server :dont-close t)
  (my-app:start-server) ; Essentially creates a hunchentoot handler and returns
  (loop for x = (read-line)
     when (string= x "q") do (quit)
     do (format t "Type q to quit~%" x)))

(save-application "my-app" :toplevel-function #'main :prepend-kernel t)

有没有更好的方法？我不喜欢循环，但释放终端的东西也可以。

【问题讨论】：

释放终端必然是平台（OS）特定的。您在哪个平台上运行您的应用程序？另外，请澄清您对“更好的方式”的定义。在您看来，最佳的 main 函数会做什么？
“更好的方式”我猜是主观的。我真正的意思是惯用/最佳实践，甚至是改进代码的建议。是否有必要有一个循环来执行阻塞读取行，或者有没有其他方法不退出？我正在 OSX 上开发，不确定终端是否会释放。

标签： common-lisp ccl toplevel

【解决方案1】：

正如你所说，一旦 main 函数完成，应用程序就会退出。因此，您需要保持功能运行，直到您希望退出应用程序。

最简单的解决方案是让主循环进入sleep的无限循环：

(defun main ()
  (swank:create-server :dont-close t)
  (my-app:start-server)
  (loop (sleep 60)))

当您启动 Swank 服务器时，您可能希望包含通过 SLIME 连接干净地退出应用程序的功能。例如，您可以使用 bt-semaphore 包编写如下内容：

(defvar *quit-my-app* (bt-semaphore:make-semamphore))

(defun main ()
  (swank:create-server :dont-close t)
  (my-app:start-server)
  (bt-semaphore:wait-on-semaphore *quit-my-app*)
  (my-app:clean-up)) ; or whatever you need to do for cleaning up

(defun quit-my-app ()
  (bt-semaphore:signal-semaphore *quit-my-app*))

现在您可以简单地在 SLIME 连接上评估 (quit-my-app) 以关闭应用程序。

您也可以使用主线程来执行维护任务。在我的服务器中，我在那里执行简单的日志轮换：

(defun seconds-until-tomorrow ()
  (multiple-value-bind (second minute hour day month year daylight-p zone)
      (decode-universal-time (+ (get-universal-time) (* 60 60 26))) ; safely tomorrow
    (declare (ignore second minute hour daylight-p))
    (- (encode-universal-time 0 0 0 day month year zone)
       (get-universal-time))))

(defun main ()
  (swank:create-server :dont-close t)
  (let (cur-logfile
        cur-logfile-name
        ;; assuming that start-server returns the Hunchentoot acceptor
        (acpt (my-app:start-server)))
    (loop
       (let* ((lf-stem (log-file-name))
              (logfile-name (merge-pathnames lf-stem *temp-path*))
              (new-logfile (open logfile-name :direction :output 
                                              :if-exists :append 
                                              :if-does-not-exist :create)))

         (setf (hunchentoot:acceptor-message-log-destination acpt) new-logfile
               (hunchentoot:acceptor-access-log-destination acpt) new-logfile)

         (when cur-logfile
           (close cur-logfile)
           (run-program "/usr/bin/xz" (list (princ-to-string cur-logfile-name))))

         (setf cur-logfile new-logfile
               cur-logfile-name logfile-name)

         (when (bt-semaphore:wait-on-semaphore *quit-my-app* (seconds-until-tomorrow))
           (return)))))

【讨论】：