[cl-irc-devel] [PATCH] keeping users administration synched

[Erik Huelsmann]

While trying to implement the irc-mode-message hook (and thus modes) in the
library, I found some instances defunct users are not cleaned.

The patch below resolves that for the most part, but there is one instance
which I can't clear up with a minimal patch. To clear up the workaround in
the event.lisp handlers, I'd need to add a connection slot to the channel
class. 

What is the general sentiment about this patch?

bye,

Erik.


Index: event.lisp
===================================================================
RCS file: /project/cl-irc/cvsroot/cl-irc/event.lisp,v
retrieving revision 1.4
diff -u -5 -r1.4 event.lisp
--- event.lisp	21 May 2004 19:12:06 -0000	1.4
+++ event.lisp	23 Jun 2004 19:10:26 -0000
@@ -85,11 +85,15 @@
   (let* ((connection (connection message))
          (channel (find-channel connection (first (arguments message))))
          (user (find-user connection (source message))))
     (if (self-message-p message)
         (remove-channel user channel)
-        (remove-user channel user))))
+      (unless (remove-user channel user)
+        ;; workaround for remove-user on channel objects:
+        ;; if the user parts but does not stay in any other channels:
+        ;; remove the object from the connection
+        (remove-user connection user)))))
 
 (defmethod default-hook ((message irc-quit-message))
   (let ((connection (connection message)))
     (remove-user-everywhere connection (find-user connection (source
message)))))
 
@@ -102,11 +106,15 @@
   (let* ((connection (connection message))
          (channel (find-channel connection (first (arguments message))))
          (user (find-user connection (second (arguments message)))))
     (if (self-message-p message)
         (remove-channel user channel)
-        (remove-user channel user))))
+      (unless (remove-user channel user)
+        ;; workaround for remove-user on channel objects:
+        ;; if the user parts but does not stay in any other channels:
+        ;; remove the object from the connection
+        (remove-user connection user)))))
 
 (defmethod default-hook ((message ctcp-time-message))
   (multiple-value-bind (second minute hour date month year day)
(get-decoded-time)
     (send-irc-message
      (connection message)
Index: protocol.lisp
===================================================================
RCS file: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v
retrieving revision 1.9
diff -u -5 -r1.9 protocol.lisp
--- protocol.lisp	22 Jun 2004 18:47:08 -0000	1.9
+++ protocol.lisp	23 Jun 2004 19:10:28 -0000
@@ -357,25 +357,35 @@
 be found, return nil."
   (let ((channel-name (normalize-channel-name channel)))
     (gethash channel-name (channels connection))))
 
 (defmethod remove-all-channels ((connection connection))
-  "Remove all channels known to `connection'."
+  "Remove all channels known to `connection' keeping `user(s)' in sync."
+  (setf (channels (user connection)) nil)
+  (clrhash (users connection))
   (clrhash (channels connection)))
 
 (defmethod add-channel ((connection connection) (channel channel))
   "Add `channel' to `connection'."
   (setf (gethash (normalized-name channel) (channels connection)) channel))
 
 (defmethod remove-channel ((connection connection) (channel channel))
-  "Remove `channel' from `connection'."
+  "Remove `channel' from `connection' keeping `users' in sync."
+  (remove-users channel)
   (remhash (normalized-name channel) (channels connection)))
 
 (defmethod remove-users ((channel channel))
   "Remove all users on `channel'."
+  (maphash #'(lambda (nick user) (remove-channel user channel))
+           (users channel))
   (clrhash (users channel)))
 
+(defmethod real-user-count ((channel channel))
+  (if (zerop (hash-table-count (users channel)))
+      (user-count channel)
+    (hash-table-count (users channel))))
+
 ;;
 ;; User
 ;;
 
 (defclass user ()
@@ -463,15 +473,19 @@
 (defmethod add-user ((channel channel) (user user))
   (setf (gethash (normalized-nickname user) (users channel)) user)
   (pushnew channel (channels user)))
 
 (defmethod remove-all-users ((connection connection))
-  "Remove all users known to `connection'."
+  "Remove all users known to `connection' keeping `channels' in sync."
+  (maphash #'(lambda (key channel) (remove-users channel))
+           (channels connection))
   (clrhash (users connection)))
 
 (defmethod remove-user ((channel channel) (user user))
   "Remove `user' from `channel' and `channel' from `user'."
+  ;;FIXME: remove this user from the connection when he has no channels!
+  ;; problem: there is no connection instance to remove from....
   (remhash (normalized-nickname user) (users channel))
   (setf (channels user) (remove channel (channels user))))
 
 (defmethod remove-channel ((channel channel) (user user))
   "Remove `channel' from `user'."
@@ -480,12 +494,12 @@
                 "use of depricated API (remove-channel channel user): "
                 "(remove-channel user channel) is now preferred"))
   (remove-channel user channel))
 
 (defmethod remove-channel ((user user) (channel channel))
-  "Remove `channel' from `user'."
-  (setf (channels user) (remove channel (channels user))))
+  "Remove `channel' from `user' vice versa."
+  (remove-user channel user))
 
 (defmethod remove-user ((connection connection) (user user))
   "Remove `user' from `connection' but leave user in any channels he
 may be already be on."
   (remhash (normalized-nickname user) (users connection)))

-- 
"Sie haben neue Mails!" - Die GMX Toolbar informiert Sie beim Surfen!
Jetzt aktivieren unter http://www.gmx.net/info