From c099ce5b24762d430a73dfc9c99e65783933ccc6 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 29 Mar 2004 18:33:27 +0000 Subject: [PATCH] r8777: improvements background monitor --- debian/changelog | 6 ++++++ logger.lisp | 53 +++++++++++++++++++++++++----------------------- 2 files changed, 34 insertions(+), 25 deletions(-) diff --git a/debian/changelog b/debian/changelog index 0b71abf..1aaf4ff 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-irc-logger (0.8.3-1) unstable; urgency=low + + * New upstream, improvements to background monitor + + -- Kevin M. Rosenberg Mon, 29 Mar 2004 11:32:52 -0700 + cl-irc-logger (0.8.2-1) unstable; urgency=low * Fix compilation on SBCL diff --git a/logger.lisp b/logger.lisp index 1429451..71b0723 100644 --- a/logger.lisp +++ b/logger.lisp @@ -599,13 +599,14 @@ nick) nil) (t - (ignore-errors (irc:quit (connection logger) "")) - (stop-background-message-handler (handler logger)) + (ignore-errors (quit-with-timeout (connection logger) "")) + (ignore-errors (stop-background-message-handler (handler logger))) (sleep 1) (dolist (channel (channels logger)) (let ((c (connection logger))) (when c (ignore-errors (remove-channel c (find-channel c (name channel))))))) + (ignore-errors (add-private-log-entry logger "Deleting loggers with nick of '~A' [remove-logger]." nick)) (when (private-log-stream logger) (close (private-log-stream logger))) (when (unknown-log-stream logger) @@ -722,7 +723,7 @@ #+allegro (mp:with-timeout (*timeout* nil) (%is-connected logger))) -(defun quit-maybe-timeout (connection msg) +(defun quit-with-timeout (connection msg) #-allegro (quit connection msg) #+allegro (mp:with-timeout (*timeout* nil) (quit connection msg))) @@ -750,7 +751,7 @@ (log-disconnection logger) (when (connection logger) - (ignore-errors (quit-maybe-timeout (connection logger) "Client terminated by server")) + (ignore-errors (quit-with-timeout (connection logger) "Client terminated by server")) (setf *recon-nick* (nickname logger) *recon-server* (server logger) *recon-username* (username logger) @@ -790,26 +791,28 @@ ;; run forever (loop do - (block main-loop - (dolist (logger *loggers*) - (do ((warning-time (warning-message-utime logger) (warning-message-utime logger))) - ((or (is-connected logger) (null warning-time))) - (cond - ((and warning-time (> (- (get-universal-time) warning-time) 180)) - ;;give up frequent checking because no disconnection despite waiting - (setf (warning-message-utime logger) nil)) - ((not (is-connected logger)) - (unless warning-time - (setf (warning-message-utime logger) (get-universal-time))) - (attempt-reconnection logger) - ;;after a succesful reconnection, the value of logger will be invalid - (sleep 30) - (return-from main-loop)) - (t - (daemon-sleep 30))))) - (do ((i 0 (1+ i))) - ((or (>= i 20) (some (lambda (logger) (warning-message-utime logger)) *loggers*))) - (daemon-sleep 15))))) - + (monitor-once))) + +(defun monitor-once () + (dolist (logger *loggers*) + (do ((warning-time (warning-message-utime logger) (warning-message-utime logger))) + ((and (is-connected logger) (null warning-time))) + (cond + ((and warning-time (> (- (get-universal-time) warning-time) 180)) + ;;give up frequent checking because no disconnection despite waiting + (setf (warning-message-utime logger) nil)) + ((not (is-connected logger)) + (unless warning-time + (setf (warning-message-utime logger) (get-universal-time))) + (attempt-reconnection logger) + ;;after a succesful reconnection, the value of logger will be invalid + (sleep 30) + (return-from monitor-once)) + (t + (daemon-sleep 30))))) + (do ((i 0 (1+ i))) + ((or (>= i 10) (some (lambda (logger) (warning-message-utime logger)) *loggers*))) + (daemon-sleep 15))) + -- 2.34.1