Paste number 313414: complete loop

Paste number 313414: complete loop
Pasted by: phf
When:8 years, 11 months ago
Share:Tweet this! | http://paste.lisp.org/+6PTY
Channel:None
Paste contents:
Raw Source | XML | Display As

(defvar *last-pong* nil)
(defvar *connection-state* nil)
(defvar *tick* 5)
(defvar *irc-monitor-verbose-p* nil)

(defun start-background-message-handler ()
  (setq *connection-event-process*
         (mp:make-process (lambda ()
                            (loop
                               (handler-case (irc:read-message *connection*)
                                 (error (err)
                                   (format t "IRC:READ-MESSAGE ERROR: ~a~%" err)
                                   (setq *connection-state* :disconnect)))))
                          :name (format nil "irc-message-handler"))))

(defun start-irc-state-monitor-thread ()
  (mp:make-process
   #'(lambda ()
       (block exit
         (loop
           (let* ((ts (get-universal-time))
                  (td (- ts (or *last-pong* 0))))
             (setq *connection-state*
                   (ecase *connection-state*
                     ((nil) (progn
                              (unless (and *connection*
                                           (irc:connectedp *connection*))
                                (setq *connection* (irc-connect)))
                              (setq *last-pong* ts)
                              (start-background-message-handler)
                              :connected))
                     (:disconnected
                      (setq *connection-state* nil)
                      (format t "irc bot disconnected, terminating~%")
                      (return-from exit))
                     (:connected (cond ((>= td 30) :needs-ping)
                                       (t :connected)))
                     (:needs-ping (ignore-errors (irc:ping *connection* (prin1-to-string ts)))
                                  :waiting-ping)
                     (:waiting-ping (cond ((< td 30) :connected)
                                          ((> td 60) :disconnect)
                                          (t :waiting-ping)))
                     (:disconnect (ignore-errors (irc-disconnect *connection*))
                                  (mp:destroy-process *connection-event-process*)
                                  :disconnected)))
             (when *irc-monitor-verbose-p*
               (format t "state: ~a~%" *connection-state*)))
           (sleep *tick*))))
   :name "irc-state-monitor"))

(defun connection-pong-handler (message)
  (destructuring-bind (server ping-time) (irc:arguments message)
    (declare (ignore server))
    (when-let ((ping-time (ignore-errors (parse-integer ping-time))))
      (setq *last-pong* (max ping-time (or *last-pong* 0)))))
  t)

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.