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: |
(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.