[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