[Lisppaste-cvs] CVS update: lisppaste2/irc-notification.lisp lisppaste2/variable.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Sun Oct 24 19:54:34 UTC 2004


Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/tmp/cvs-serv24665

Modified Files:
	irc-notification.lisp variable.lisp 
Log Message:
More changes for multiple server support

Date: Sun Oct 24 21:54:33 2004
Author: bmastenbrook

Index: lisppaste2/irc-notification.lisp
diff -u lisppaste2/irc-notification.lisp:1.2 lisppaste2/irc-notification.lisp:1.3
--- lisppaste2/irc-notification.lisp:1.2	Wed Oct 20 22:37:50 2004
+++ lisppaste2/irc-notification.lisp	Sun Oct 24 21:54:33 2004
@@ -1,18 +1,39 @@
-;;;; $Id: irc-notification.lisp,v 1.2 2004/10/20 20:37:50 bmastenbrook Exp $
+;;;; $Id: irc-notification.lisp,v 1.3 2004/10/24 19:54:33 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/irc-notification.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
 
 (in-package :lisppaste)
 
+(defvar *connections* nil)
+(defvar *nicknames* nil)
+
+(defun channel-nick (channel)
+  (cdr (assoc channel *nicknames*
+		    :test #'(lambda (e s)
+			      (member e s :test #'string=)))))
+
+(defun nick-connection (nick)
+  (cdr (assoc nick *connections* :test #'string=)))
+
+(defun find-connection (channel)
+  (nick-connection (channel-nick channel)))
+
 (defun irc-say-help (channel)
-  (when (and *connection*
+  (when (and (find-connection channel)
              (find channel *channels* :test #'string=))
-    (irc:privmsg *connection*
+    (irc:privmsg (find-connection channel)
                  channel
                  (format nil "To use the lisppaste bot, visit ~A/~A and enter your paste." (araneida:urlstring *new-paste-url*) (subseq channel 1)))
     t))
 
+(defun excluding-trailing-digits (nick)
+  (coerce
+   (loop for i from (1- (length nick)) downto 0
+      if (not (digit-char-p (elt nick i)))
+      return (subseq nick 0 (1+ i)))
+   'string))
+       
 (defun help-request-p (nick help text)
   (and (> (length text)
           (length nick))
@@ -21,24 +42,24 @@
                                    :test #'char-equal)))
          (and
           url-position
-          (notany #'alphanumericp (subseq text (length nick) (1- url-position)))
-          (notany #'alphanumericp (subseq text (+ url-position (length help))))))))
+          (notany #'alpha-char-p (subseq text (length nick) (1- url-position)))
+          (notany #'alpha-char-p (subseq text (+ url-position (length help))))))))
 
-(defun make-irc-msg-hook (nick)
+(defun make-irc-msg-hook (connection nick)
   (lambda (message)
     (let ((text (irc:trailing-argument message)))
       (cond ((string= (first (irc:arguments message)) nick)
-             (irc:privmsg *connection*
+             (irc:privmsg connection
                           (irc:source message)
                           (format nil "To use the lisppaste bot, visit ~A and enter your paste. Be sure to select the right channel!" (araneida:urlstring *new-paste-url*))))
             ((some #'(lambda (e)
-                       (help-request-p nick e text))
+                       (help-request-p (excluding-trailing-digits nick) e text))
                    '("url" "help" "hello"))
              (irc-say-help (first (irc:arguments message))))))))
 
-(defun add-irc-hook (nick)
-  (irc:remove-hooks *connection* 'irc:irc-privmsg-message)
-  (irc:add-hook *connection* 'irc:irc-privmsg-message (make-irc-msg-hook nick)))
+(defun add-irc-hook (connection nick)
+  (irc:remove-hooks connection 'irc:irc-privmsg-message)
+  (irc:add-hook connection 'irc:irc-privmsg-message (make-irc-msg-hook connection nick)))
 
 (defun start-irc-notification (&key (channels (list *default-channel*))
                                (nickname *default-nickname*)
@@ -48,36 +69,58 @@
                                  :realname (araneida:urlstring *new-paste-url*)
                                  :server server
                                  :port port)))
-    (setf *connection* connection)
-    (setf *channels* (nconc *channels* channels))
-    (setf *nickname* nickname)
+    (push (cons nickname connection) *connections*)
+    (setf *channels* (append *channels* channels))
+    (push (cons (copy-list channels) nickname) *nicknames*)
     (mapcar #'(lambda (channel) (irc:join connection channel)) channels)
-    (add-irc-hook nickname)
+    (add-irc-hook connection nickname)
     (irc:start-background-message-handler connection)))
 
-(defun join-new-irc-channel (channel)
-  (setf *channels* (nconc *channels* (list channel)))
-  (irc:join *connection* channel))
+(defun stop-irc-notification (nickname)
+  (ignore-errors (irc:quit (nick-connection nickname)))
+  (loop for i in (car (rassoc nickname *nicknames* :test #'string=))
+     do (setf *channels* (remove i *channels* :test #'string=)))
+  (setf *nicknames* (remove nickname *nicknames* :key #'cdr :test #'string=))
+  (setf *connections* (remove nickname *connections* :key #'car :test #'string=)))
+
+(defun join-new-irc-channel (nickname channel)
+  (push channel (car (rassoc nickname *nicknames* :test #'string=)))
+  (irc:join (find-connection channel) channel)
+  (setf *channels* (nconc *channels* (list channel))))
 
-(defun leave-irc-channel (channel)
+(defun leave-irc-channel (nickname channel)
   (setf *channels* (remove channel *channels* :test #'string-equal))
-  (irc:part *connection* channel))
-
-(defun hup-irc-connection (server)
-  (ignore-errors (irc:quit *connection*))
-  (setf *connection* (irc:connect :nickname *nickname*
-				  :realname (araneida:urlstring *new-paste-url*)
-				  :server server
-				  :port *default-irc-server-port*))
-  (mapcar #'(lambda (channel) (irc:join *connection* channel)) *channels*)
-  (add-irc-hook *nickname*)
-  (irc:start-background-message-handler *connection*))
+  (irc:part (find-connection channel) channel)
+  (setf (car (rassoc nickname *nicknames* :test #'string=))
+	(remove channel (car (rassoc nickname *nicknames* :test #'string=))
+		:test #'string=)))
+
+(defun hup-irc-connection (nickname &optional (server *default-irc-server*))
+  (ignore-errors (irc:quit (nick-connection nickname)))
+  (sleep 1)
+  (setf
+   (cdr (assoc nickname *connections* :test #'string=))
+   (irc:connect :nickname nickname
+		:realname (araneida:urlstring *new-paste-url*)
+		:server server
+		:port *default-irc-server-port*))
+  (mapcar #'(lambda (channel) (irc:join (nick-connection nickname) channel))
+	  (car (rassoc nickname *nicknames* :test #'string=)))
+  (add-irc-hook (nick-connection nickname) nickname)
+  (irc:start-background-message-handler (nick-connection nickname)))
+
+(defun %shut-up (connection)
+  (setf (irc:client-stream connection)
+	(make-broadcast-stream)))
 
 (defun shut-up ()
-  (setf (irc:client-stream *connection*) (make-broadcast-stream)))
+  (mapc #'%shut-up (mapcar #'cdr *connections*)))
+
+(defun %un-shut-up (connection)
+  (setf (irc:client-stream connection) *trace-output*))
 
 (defun un-shut-up ()
-  (setf (irc:client-stream *connection*) *trace-output*))
+  (mapc #'%un-shut-up (mapcar #'cdr *connections*)))
 
 (defun irc-notify (channel text)
-  (irc:privmsg *connection* channel text))
+  (irc:privmsg (find-connection channel) channel text))


Index: lisppaste2/variable.lisp
diff -u lisppaste2/variable.lisp:1.34 lisppaste2/variable.lisp:1.35
--- lisppaste2/variable.lisp:1.34	Wed Oct 20 22:39:21 2004
+++ lisppaste2/variable.lisp	Sun Oct 24 21:54:33 2004
@@ -1,4 +1,4 @@
-;;;; $Id: variable.lisp,v 1.34 2004/10/20 20:39:21 bmastenbrook Exp $
+;;;; $Id: variable.lisp,v 1.35 2004/10/24 19:54:33 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -23,12 +23,12 @@
 
 (in-package :lisppaste)
 
-(defparameter *internal-http-port* 8080
+(defparameter *internal-http-port* 8081
   "Port lisppaste's araneida will listen on for requests from Apache.")
-(defparameter *external-http-port* 80
+(defparameter *external-http-port* 8081
   "Port lisppaste's araneida will listen on for requests from remote clients.")
 
-(defparameter *paste-site-name* "paste.lisp.org"
+(defparameter *paste-site-name* "www.unmutual.info"
   "Website we are running on (used for creating links).")
 
 (defparameter *paste-external-url*
@@ -37,7 +37,7 @@
                       :host *paste-site-name*
                       ;;; comment out this next line when running
                       ;;; behind a proxying apache
-		      #| :port *external-http-port* |#
+		      :port *external-http-port*
                       ) "/"))
 
 (defparameter *old-url* (araneida:merge-url
@@ -153,8 +153,7 @@
 
 (defvar *pastes* nil)
 (defvar *paste-counter* 0)
-(defvar *connection* nil)
-(defvar *nickname*)
+
 (defvar *channels* '("None"))
 
 (defvar *paste-file*





More information about the Lisppaste-cvs mailing list