[net-nittin-irc-cvs] CVS update: net-nittin-irc/TODO net-nittin-irc/event.lisp net-nittin-irc/protocol.lisp
Erik Enge
eenge at common-lisp.net
Mon Nov 24 21:30:15 UTC 2003
Update of /project/net-nittin-irc/cvsroot/net-nittin-irc
In directory common-lisp.net:/tmp/cvs-serv17874
Modified Files:
TODO event.lisp protocol.lisp
Log Message:
find-user is now very fast, comparatively speaking however it came at
the sacrifice of nickname-equalness being broken for now. will think
of a fix later.
Date: Mon Nov 24 16:30:12 2003
Author: eenge
Index: net-nittin-irc/TODO
diff -u net-nittin-irc/TODO:1.8 net-nittin-irc/TODO:1.9
--- net-nittin-irc/TODO:1.8 Sun Nov 23 22:16:49 2003
+++ net-nittin-irc/TODO Mon Nov 24 16:30:11 2003
@@ -3,12 +3,15 @@
- Add DCC
- - Need to optimize the user approach. When joining ten high-volume
- (2000+ users total) channels there seems to be O(n) or somesuch
- performance because of, I'm guessing, the way FIND-USER works.
+ - I would really like usocket first
- If a message (as in PRIVMSG) is longer than 512 characters
(including carriage return and linefeed) we should probably split
the message into several on behalf of the user.
+ - should send-irc-message automatically do this for you?
+
- Add ignore
+
+ - During find-user optimization, I broke with irc-nick-equal for
+ nicknames in find-user.
Index: net-nittin-irc/event.lisp
diff -u net-nittin-irc/event.lisp:1.10 net-nittin-irc/event.lisp:1.11
--- net-nittin-irc/event.lisp:1.10 Sun Nov 23 18:21:38 2003
+++ net-nittin-irc/event.lisp Mon Nov 24 16:30:11 2003
@@ -1,4 +1,4 @@
-;;;; $Id: event.lisp,v 1.10 2003/11/23 23:21:38 eenge Exp $
+;;;; $Id: event.lisp,v 1.11 2003/11/24 21:30:11 eenge Exp $
;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $
;;;; See LICENSE for licensing information.
@@ -33,7 +33,7 @@
(make-channel :name channel
:topic topic
:user-count user-count))
- (channel-list connection))))
+ (channels connection))))
(defmethod default-hook ((message irc-rpl_topic-message))
(setf (topic (find-channel (connection message)
@@ -41,13 +41,15 @@
(trailing-argument message)))
(defmethod default-hook ((message irc-rpl_namreply-message))
- (let ((channel (find-channel (connection message) (car (last (arguments message))))))
+ (let* ((connection (connection message))
+ (channel (find-channel connection (car (last (arguments message))))))
(dolist (nickname (tokenize-string (trailing-argument message)))
- (add-user channel
- (find-or-make-user (connection message)
- (canonicalize-nickname nickname)
- :username (user message)
- :hostname (host message))))))
+ (let ((user (find-or-make-user connection
+ (canonicalize-nickname nickname)
+ :username (user message)
+ :hostname (host message))))
+ (unless (equal user (user connection))
+ (add-user connection channel user))))))
(defmethod default-hook ((message irc-ping-message))
(pong (connection message) (trailing-argument message)))
@@ -63,7 +65,7 @@
(make-channel :name (trailing-argument message)))))
(if (self-message-p message)
(add-channel connection channel)
- (add-user channel user))))
+ (add-user connection channel user))))
(defmethod default-hook ((message irc-topic-message))
(setf (topic (find-channel (connection message)
@@ -75,7 +77,7 @@
(channel (find-channel connection (first (arguments message))))
(user (find-user connection (source message))))
(if (self-message-p message)
- (remove-channel connection channel)
+ (remove-channel channel user)
(remove-user channel user))))
(defmethod default-hook ((message irc-quit-message))
@@ -98,7 +100,7 @@
(channel (find-channel connection (first (arguments message))))
(user (find-user connection (second (arguments message)))))
(if (self-message-p message)
- (remove-channel connection channel)
+ (remove-channel channel user)
(remove-user channel user))))
(defmethod default-hook ((message ctcp-time-message))
Index: net-nittin-irc/protocol.lisp
diff -u net-nittin-irc/protocol.lisp:1.17 net-nittin-irc/protocol.lisp:1.18
--- net-nittin-irc/protocol.lisp:1.17 Sun Nov 23 22:16:26 2003
+++ net-nittin-irc/protocol.lisp Mon Nov 24 16:30:11 2003
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.17 2003/11/24 03:16:26 eenge Exp $
+;;;; $Id: protocol.lisp,v 1.18 2003/11/24 21:30:11 eenge Exp $
;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $
;;;; See LICENSE for licensing information.
@@ -20,6 +20,7 @@
;; Connection
;;
+
(defclass connection ()
((user
:initarg :user
@@ -46,23 +47,14 @@
:initarg :channels
:accessor channels
:initform nil)
- (channel-list
- :initarg :channel-list
- :accessor channel-list
- :initform nil
- :documentation "A list of channels known to this server as
-recorded by the LIST command.")
(hooks
:initarg :hooks
:accessor hooks
:initform (make-hash-table :test #'equal))
- (dangling-users
- :initarg :dangling-users
- :accessor dangling-users
- :initform nil
- :documentation "A list of all users we currently know of which are
-not associated with a given channel. There are no provisions given
-for making sure that these users actually are online.")))
+ (users
+ :initarg :users
+ :accessor users
+ :initform (make-hash-table :test #'equal))))
(defmethod print-object ((object connection) stream)
"Print the object for the Lisp reader."
@@ -74,19 +66,13 @@
(server-socket nil)
(server-stream nil)
(client-stream t)
- (channels nil)
- (dangling-users nil)
- (hooks nil)
- (channel-list nil))
+ (hooks nil))
(let ((connection (make-instance 'connection
:user user
:server-name server-name
:server-socket server-socket
:server-stream server-stream
- :client-stream client-stream
- :channels channels
- :dangling-users dangling-users
- :channel-list channel-list)))
+ :client-stream client-stream)))
(dolist (hook hooks)
(add-hook connection (car hook) (cadr hook)))
connection))
@@ -99,7 +85,7 @@
irc-ping-message
irc-join-message
irc-topic-message
- irc-ping-message
+ irc-part-message
irc-quit-message
irc-kick-message
irc-nick-message
@@ -167,24 +153,6 @@
(force-output (server-stream connection))
raw-message))
-(defmethod all-users ((connection connection))
- "Return all users known the `connection'."
- (let ((user-list (dangling-users connection)))
- (push (user connection) user-list)
- (dolist (channel (channels connection))
- (maphash #'(lambda (key value)
- (declare (ignore key))
- (push value user-list)) (users channel)))
- (remove-duplicates user-list)))
-
-(defmethod all-channels ((connection connection))
- "Return a list of all channels known to the `connection'. Note that
-this includes any channels found by listing channels."
- (let ((channel-list (channel-list connection)))
- (dolist (channel (channels connection))
- (push channel channel-list))
- channel-list))
-
(defmethod get-hooks ((connection connection) (class symbol))
"Return a list of all hooks for `class'."
(gethash class (hooks connection)))
@@ -203,6 +171,9 @@
"Remove all hooks for `class'."
(setf (gethash class (hooks connection)) nil))
+(defmethod remove-all-hooks ((connection connection))
+ (clrhash (hooks connection)))
+
;;
;; DCC Connection
;;
@@ -325,7 +296,7 @@
(defmethod find-channel ((connection connection) (channel string))
"Return channel as designated by `channel'. If no such channel can
be found, return nil."
- (find channel (all-channels connection) :key #'name :test #'string-equal))
+ (find channel (channels connection) :key #'name :test #'string-equal))
(defmethod remove-all-channels ((connection connection))
"Remove all channels known to `connection'."
@@ -363,7 +334,11 @@
(realname
:initarg :realname
:accessor realname
- :initform "")))
+ :initform "")
+ (channels
+ :initarg :channels
+ :accessor channels
+ :initform nil)))
(defmethod print-object ((object user) stream)
"Print the object for the Lisp reader."
@@ -403,32 +378,40 @@
rules in IRC goes."
(string-equal (irc-nick-mangle string1) (irc-nick-mangle string2)))
+;; this is broken. we should use #'irc-nick-equal somehow.
(defmethod find-user ((connection connection) (nickname string))
"Return user as designated by `nickname' or nil if no such user is
known."
- (find nickname (all-users connection) :key #'nickname :test #'irc-nick-equal))
-
-(defmethod add-user ((connection connection) (user user))
- "Add `user' to `connection'."
- (pushnew user (dangling-users connection)))
-
-(defmethod add-user ((channel channel) (user user))
- "Add `user' to `channel'."
- (setf (gethash (nickname user) (users channel)) user))
+ (or (gethash nickname (users connection))
+ (when (string= nickname (nickname (user connection)))
+ (user connection))))
+
+; what if the user is not on any channels?
+(defmethod add-user ((connection connection) (channel channel) (user user))
+ "Add `user' to `channel' and `channel' to `user'."
+ (setf (gethash (nickname user) (users channel)) user)
+ (pushnew channel (channels user))
+ (setf (gethash (nickname user) (users connection)) user))
(defmethod remove-all-users ((connection connection))
"Remove all users known to `connection'."
- (setf (dangling-users connection) nil)
+ (setf (users connection) nil)
(mapc #'remove-users (channels connection)))
(defmethod remove-user ((channel channel) (user user))
- "Remove `user' from `channel'."
- (remhash (nickname user) (users channel)))
+ "Remove `user' from `channel' and `channel' from `user'."
+ (remhash (nickname user) (users channel))
+ (setf (channels user) (remove channel (channels user))))
+
+(defmethod remove-channel ((channel channel) (user user))
+ "Remove `channel' from `user'."
+ (setf (channels user) (remove channel (channels user))))
(defmethod remove-user-everywhere ((connection connection) (user user))
"Remove `user' anywhere present in the `connection'."
- (dolist (channel (channels connection))
- (remove-user channel user)))
+ (dolist (channel (channels user))
+ (remove-user channel user))
+ (remhash (nickname user) (users connection)))
(defmethod find-or-make-user ((connection connection) nickname &key (username "")
(hostname "") (realname ""))
@@ -442,9 +425,9 @@
(dolist (channel (channels connection))
(let ((old-user (gethash (nickname user) (users channel))))
(when old-user
- (remhash (nickname user) (users channel))
+ (remove-user channel user)
(setf (nickname user) new-nickname)
- (add-user channel user))))
+ (add-user connection channel user))))
(when (equal user (user connection))
(setf (nickname user) new-nickname)))
More information about the Net-nittin-irc-cvs
mailing list