From d2506e00f04b101331b460806d23cb47364ebec5 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 17 Dec 2003 23:35:29 +0000 Subject: [PATCH] r8372: add add/remove channel functions --- debian/changelog | 7 +++++ logger.lisp | 82 +++++++++++++++++++++++++++++++++--------------- package.lisp | 4 ++- 3 files changed, 67 insertions(+), 26 deletions(-) diff --git a/debian/changelog b/debian/changelog index d426376..0a97e0e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +cl-irc-logger (0.4-1) unstable; urgency=low + + * Fix bug with :mode event + * add remove-channel, add-channel + + -- Kevin M. Rosenberg Wed, 17 Dec 2003 14:54:30 -0700 + cl-irc-logger (0.3-1) unstable; urgency=low * New upstream diff --git a/logger.lisp b/logger.lisp index 1382ef4..7baa241 100644 --- a/logger.lisp +++ b/logger.lisp @@ -1,4 +1,4 @@ -;;;; -*- Mode: Lisp -*- +o;;; -*- Mode: Lisp -*- ;;;; $Id: logger.lisp,v 1.11 2003/12/16 21:19:56 krosenberg Exp $ ;;;; ;;;; Purpose: A IRC logging bot @@ -24,7 +24,7 @@ :documentation "Nickname's nickserver password.") (server :initarg :server :reader server :documentation "Connected IRC server.") - (channels :initarg :channels :reader channels + (channels :initarg :channels :accessor channels :documentation "List of channels.") (user-output :initarg :user-output :reader user-output :documentation @@ -50,9 +50,15 @@ (defun find-logger-with-connection (conn) (find conn (the list *loggers*) :test #'eq :key #'connection)) +(defun canonicalize-channel-name (name) + (string-left-trim '(#\#) name)) + +(defun find-channel-with-name (logger name) + (find name (the list (channels logger)) :test #'string-equal :key #'name)) + (defun make-output-name (name year month day) - (format nil "~A-~4,'0D.~2,'0D.~2,'0D" - (string-left-trim '(#\#) name) year month day)) + (format nil "~A-~4,'0D.~2,'0D.~2,'0D" (canonicalize-channel-name name) + year month day)) (defun make-output-name-utime (name utime) (multiple-value-bind @@ -248,8 +254,7 @@ (dotimes (i (length (formats logger))) (output-event-for-a-stream msg type channel text logger i)))) (t - (let* ((channel (find channel-name (the list (channels logger)) - :test #'string-equal :key #'name))) + (let* ((channel (find-channel-with-name logger channel-name))) (when channel (dotimes (i (length (formats logger))) (output-event-for-a-stream msg type channel text logger i)))))))) @@ -290,19 +295,22 @@ (output-event msg :topic (first (arguments msg)) (trailing-argument msg))) (defun mode-hook (msg) - (output-event msg :mode (first (arguments msg)))) - + (output-event msg :mode (first (arguments msg)) + (format nil "~{~A~^ ~}" (cdr (arguments msg))))) + +(defun make-a-channel (name formats output) + (make-instance 'channel + :name name + :streams (make-array (length formats) :initial-element nil) + :output-root (when (and (pathnamep output) + (null (pathname-name output))) + output) + :current-output-names (make-array (length formats) + :initial-element nil))) + (defun make-channels (names formats output) (loop for i from 0 to (1- (length names)) - collect - (make-instance 'channel - :name (nth i names) - :streams (make-array (length formats) :initial-element nil) - :output-root (when (and (pathnamep output) - (null (pathname-name output))) - output) - :current-output-names (make-array (length formats) - :initial-element nil)))) + collect (make-a-channel (elt names i) formats output))) (defun is-unichannel-output (user-output) "Returns T if output is setup for a single channel directory structure." @@ -312,9 +320,8 @@ (logging-stream t) (formats '(:text))) "OUTPUT may be a pathname or a stream" ;; check arguments - (assert channels) (assert formats) - (if (atom channels) + (if (and channels (atom channels)) (setq channels (list channels))) (if (atom formats) (setq formats (list formats))) @@ -351,7 +358,7 @@ (start-background-message-handler (connection logger)) (read-message-loop (connection logger)))) -(defun quit-logger (nick) +(defun remove-logger (nick) "Quit the active connection with nick and remove from active list." (let ((logger (find-logger-with-nick nick))) (cond @@ -362,10 +369,7 @@ (irc:quit (connection logger)) (sleep 1) (dolist (channel (channels logger)) - (dotimes (i (length (streams channel))) - (when (streamp (get-stream channel i)) - (close (get-stream channel i)) - (setf (get-stream channel i) nil)))) + (remove-channel logger (name channel))) (setq *loggers* (delete nick *loggers* :test #'string-equal :key #'nickname)) t)))) @@ -374,7 +378,7 @@ (logging-stream t) (async t) (formats '(:text))) (when (find-logger-with-nick nick) (warn "Closing previously active connection.") - (quit-logger nick)) + (remove-logger nick)) (let ((logger (create-logger nick server :channels channels :output output :logging-stream logging-stream :password password :formats formats))) @@ -382,6 +386,34 @@ (start-logger logger async) logger)) +(defun add-channel-logger (logger channel-name) + (cond + ((find-channel-with-name logger channel-name) + (warn "Channel ~A already in logger ~A." channel-name logger) + nil) + (t + (let ((channel (make-a-channel channel-name (formats logger) (user-output logger)))) + (join (connection logger) channel-name) + (push channel (channels logger)))))) + +(defun remove-channel-logger (logger channel-name) + (let ((channel (find-channel-with-name logger channel-name))) + (cond + (channel + (part (connection logger) channel-name) + (dotimes (i (length (streams channel))) + (when (streamp (get-stream channel i)) + (close (get-stream channel i)) + (setf (get-stream channel i) nil))) + (setf (channels logger) (delete channel-name (channels logger) + :test #'string-equal + :key #'name)) + t) + (t + (warn "Channel name ~A not found in logger ~A." + channel-name logger) + nil)))) + (defun add-hook-logger (logger class hook) (add-hook (connection logger) class hook)) diff --git a/package.lisp b/package.lisp index a5f04f2..6f046c9 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,9 @@ (defpackage irc-logger (:use :common-lisp :irc :cl-ppcre) (:export #:add-logger - #:quit-logger + #:remove-logger + #:add-channel-logger + #:remove-channel-logger #:log-file-path #:add-hook-logger #:remove-hook-logger -- 2.34.1