[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/irclogs.css net-nittin-irc/example/logger.lisp - net-nittin-irc-cvs@common-lisp.net - mailman3.common-lisp.net

14 Dec 2003

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example
In directory common-lisp.net:/tmp/cvs-serv9229
Modified Files:
    irclogs.css logger.lisp 
Log Message:
add multi-directory output and user-address info
Date: Sun Dec 14 06:53:42 2003
Author: krosenberg
Index: net-nittin-irc/example/irclogs.css
diff -u net-nittin-irc/example/irclogs.css:1.1 net-nittin-irc/example/irclogs.css:1.2

--- net-nittin-irc/example/irclogs.css:1.1	Sun Dec 14 05:40:08 2003
+++ net-nittin-irc/example/irclogs.css	Sun Dec 14 06:53:41 2003
@@ -21,6 +21,10 @@
.action-msg { color:#000; }
+.user-address { color:#444; }
+
+.info-brack { color:#CCC; }
+
 .info-msg { color:#000; }
.object { color:#822; }
Index: net-nittin-irc/example/logger.lisp
diff -u net-nittin-irc/example/logger.lisp:1.3 net-nittin-irc/example/logger.lisp:1.4
--- net-nittin-irc/example/logger.lisp:1.3	Sun Dec 14 05:40:08 2003
+++ net-nittin-irc/example/logger.lisp	Sun Dec 14 06:53:41 2003
@@ -1,5 +1,5 @@
 ;;;;  -*- Mode: Lisp -*-
-;;;; $Id: logger.lisp,v 1.3 2003/12/14 10:40:08 krosenberg Exp $
+;;;; $Id: logger.lisp,v 1.4 2003/12/14 11:53:41 krosenberg Exp $
 ;;;;
 ;;;; Purpose: A logging bot 
 ;;;; Author:  Kevin Rosenberg
@@ -29,6 +29,7 @@
     :documentation "Name of channel.")
    (streams :initarg :streams :reader streams
        :documentation "List of output streams.")
+   (default-pathname :initarg :default-pathname :reader default-pathname)
    (base-name :initarg :base-name :reader base-name
          :documentation "Base file name for channel")
    (current-output-names :initarg :current-output-names :accessor current-output-names)))
@@ -46,14 +47,12 @@
    (user-output :initarg :user-output :reader user-output
    	:documentation
    	"Output parameter from user, maybe stream or pathname.")
-   (base-name :initarg :base-name :reader base-name
-	      :documentation "Base name of log files.")
    (formats :initarg :formats :reader formats
    	  :documentation
    	  "A list of output formats.")))
(defvar *loggers* nil "List of active loggers.")
-(defparameter *uri-scanner*
+(defvar *uri-scanner*
   (create-scanner
    '(:register
      (:alternation
@@ -68,6 +67,13 @@
        (:greedy-repetition 1 nil :non-whitespace-char-class))))
    :case-insensitive-mode t))
+(defparameter *user-address-scanner*
+  (create-scanner
+   '(:sequence #!
+     (:register
+      (:greedy-repetition 1 nil :non-whitespace-char-class)))
+   :case-insensitive-mode t))
+
 (defun find-logger-with-nick (nick)
   (find nick (the list *loggers*) :test #'string-equal :key #'nickname))
@@ -76,14 +82,14 @@
    (second minute hour day-of-month month year day-of-week daylight-p zone)
       (decode-universal-time utime)
     (declare (ignore second minute hour day-of-week daylight-p zone))
-    (format nil "~A~4,'0D-~2,'0D-~2,'0D" base-name year month day-of-month)))
+    (format nil "~A~4,'0D.~2,'0D.~2,'0D" base-name year month day-of-month)))
(defun output-file-header (logger channel istream)
   (case (elt (formats logger) istream)
     (:html
      (format (elt (streams channel) istream)
         "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">~%")
-     (format (elt (streams channel) istream) "<html><head><link rel="stylesheet" href="irclogs.css" type="text/css" /></head><body>~%"))))
+     (format (elt (streams channel) istream) "<html><head><link rel='stylesheet' href='/irclogs.css' type='text/css' /></head><body>~%"))))
(defun output-file-footer (logger channel istream)
   (case (elt (formats logger) istream)
@@ -97,12 +103,13 @@
    (output-file-footer logger channel istream)
    (close (elt (streams channel) istream)))
       (setf (elt (current-output-names channel) istream) name)
-      (let ((path (make-pathname :defaults (user-output logger) :name name
+      (let ((path (make-pathname :defaults (default-pathname channel) :name name
    			 :type (case (elt (formats logger) istream)
    				 (:html "html")
    				 (:sexp "sexp")
    				 (t "txt")))))
    (unless (probe-file path)
+	  (ensure-directories-exist path)
      (setf (elt (streams channel) istream)
    	(open path :direction :output :if-exists :error
    	      :if-does-not-exist :create))
@@ -152,6 +159,12 @@
         (format stream "<a href='~A'>~A</a>" item item)
         (write-string item stream)))))))
+(defun user-address (msg)
+  (let ((split (split *user-address-scanner* (raw-message-string msg) :with-registers-p t)))
+    (if (second split)
+	(second split)
+	"")))
+
 (defun output-event-for-a-stream (msg type text object logger channel istream)
   (ensure-output-stream (received-time msg) logger channel istream)
   (let ((source (source msg))
@@ -176,14 +189,16 @@
    	  "<span class='action-brack'>*</span><span class='action-name'>~A</span><span class='action-brack'>*</span> <span class='action-msg'>~A</span>"
    	  source (activate-uris text)))
     (t
-	  (format stream "<span class='subject'>~A</span> <span class='info-msg'>~A</span>"
-		  source text)
+	  (format stream "<span class='subject'>~A</span> <span class='info-brack'>[</span><span class='user-address'>~A</span><span class='info-brack'>]</span> <span class='info-msg'>~A</span>"
+		  source (user-address msg) text)
      (when object
        (format stream " <span class='object'>~A</span>" object))))
        (format stream "</div>~%"))
       (:sexp
-       (format stream "(~W ~W ~W ~W ~W)~%" (received-time msg)
-	       type source text object))
+       (format stream "(~W ~W ~W ~W ~W ~W)~%" (received-time msg)
+	       type source text object
+	       (unless (or (eq :privmsg type) (eq :action type))
+		 (user-address msg))))
       (t
        (format stream "~A " (format-time (received-time msg)))
        (case type
@@ -192,7 +207,7 @@
     (:action
      (format stream "*~A* ~A" source text))
     (t
-	  (format stream "[info] ~A ~A" source text)
+	  (format stream "[info] ~A [~A] ~A" source (user-address msg) text)
      (when object
        (format stream " ~A" object))))
        (write-char #\Newline stream)))
@@ -200,11 +215,13 @@
(defun output-event (msg type text &optional object)
   (dolist (logger *loggers*)
-    (let* ((channel-name (car (last (arguments msg))))
+    (let* ((channel-name (case type
+			   (:join
+			    (trailing-argument msg))
+			   (t
+			    (car (last (arguments msg))))))
       (channel (find channel-name (the list (channels logger))
    		  :test #'string-equal :key #'name)))
-      (print channel-name)
-      (print channel)
       (when channel
    (dotimes (i (length (formats logger)))
      (output-event-for-a-stream msg type text object logger channel i))))))
@@ -239,7 +256,6 @@
    	(first (arguments msg))))
(defun create-logger (nick server &key channels output
-		      (base-name "log-")
    	      (logging-stream t)
    	      (async t)
    	      (formats '(:text)))
@@ -247,7 +263,6 @@
   ;; check arguments
   (assert channels)
   (assert formats)
-  (assert (stringp base-name))
   (if (atom channels)
       (setq channels (list channels)))
   (if (atom formats)
@@ -266,9 +281,18 @@
    		collect (make-instance 'channel
    				       :name (nth i channels)
    				       :streams (make-list (length formats))
+					       :default-pathname
+					       (when (and (pathnamep output)
+							  (null (pathname-name output)))
+						 (merge-pathnames
+						  (make-pathname :directory
+								 (list :relative
+								       (string-left-trim
+									'(##)
+									(nth i channels))))
+						  output))
    				       :base-name
    				       (concatenate 'string
-							    base-name
    						    (string-left-trim
    						     '(##)
    						     (nth i channels))
@@ -276,7 +300,6 @@
    				       :current-output-names
    				       (make-list (length formats))))
    			:user-output output
-				:base-name base-name
    			:formats formats)))
     (mapc #'(lambda (channel) (join conn channel)) channels)
@@ -314,7 +337,6 @@
        t))))
(defun add-logger (nick server &key channels output
-		   (base-name "log-")
    	   (logging-stream t)
    	   (async t)
    	   (formats '(:text)))
@@ -323,7 +345,7 @@
     (quit-logger nick))
   (let ((logger
     (create-logger nick server :channels channels :output output
-			:base-name base-name :logging-stream logging-stream
+			:logging-stream logging-stream
    		:async async :formats formats)))
     (push logger *loggers*)
     logger))

    