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)))