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))