3

Application Delivery のすべての基本的な例は、トップレベルの関数を独自のものに置き換える方法を示しています。その機能が完了すると、アプリケーションは終了します。長時間実行されるアプリケーションのトップレベル関数を作成する最良の方法は何だろうと思っていました。私のコードは

(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)

より良い方法はありますか？ループは好きではありませんが、端末を解放するものも問題ありません。

4

1 に答える 1

2

あなたが言うように、メイン関数が完了すると、アプリケーションは終了します。したがって、アプリケーションを終了するまで関数を実行し続ける必要があります。

最も簡単な解決策は、メイン ループを次の無限ループに残すことです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)))))
于 2014-11-03T06:39:11.380 に答える