r8372: add add/remove channel functions

diff --git a/debian/changelog b/debian/changelog
index d4263769d4a9f68bbce01d688ab9af5437933c36..0a97e0e067464ba7d24cfc687e82fb28da36353f 100644 (file)
--- 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 <kmr@debian.org>  Wed, 17 Dec 2003 14:54:30 -0700
+

 cl-irc-logger (0.3-1) unstable; urgency=low
 
   * New upstream
 cl-irc-logger (0.3-1) unstable; urgency=low
 
   * New upstream

diff --git a/logger.lisp b/logger.lisp
index 1382ef49e434480fb596d29794c809abac14f3d6..7baa2415d8a227a1a54e0c781d53bac067d76e7b 100644 (file)
--- 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 
 ;;;; $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.")
             :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
             :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 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)
 (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
 
 (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
         (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))))))))
         (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 :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))
 (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."
 
 (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
                      (logging-stream t) (formats '(:text)))
   "OUTPUT may be a pathname or a stream"
   ;; check arguments

-  (assert channels)

   (assert formats)
   (assert formats)

-  (if (atom channels)
+  (if (and channels (atom channels))

       (setq channels (list channels)))
   (if (atom formats)
       (setq formats (list formats)))
       (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))))
 
       (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
   "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))
        (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))))
        (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.")
                   (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)))
   (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))
 
     (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))
 
 (defun add-hook-logger (logger class hook)
   (add-hook (connection logger) class hook))
 

diff --git a/package.lisp b/package.lisp
index a5f04f2c041e775be3d6246c00caa746288faf1f..6f046c9b5d3d5f574bd5dd99bd44e2edaa85bc63 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,9 @@
 (defpackage irc-logger
   (:use :common-lisp :irc :cl-ppcre)
   (:export #:add-logger
 (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
           #:log-file-path
           #:add-hook-logger
           #:remove-hook-logger