[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/logger.lisp

[Kevin Rosenberg]

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example
In directory common-lisp.net:/tmp/cvs-serv14934

Modified Files:
	logger.lisp 
Log Message:
store in year-month directories
Date: Sun Dec 14 12:13:19 2003
Author: krosenberg

Index: net-nittin-irc/example/logger.lisp
diff -u net-nittin-irc/example/logger.lisp:1.7 net-nittin-irc/example/logger.lisp:1.8
--- net-nittin-irc/example/logger.lisp:1.7	Sun Dec 14 11:10:29 2003
+++ net-nittin-irc/example/logger.lisp	Sun Dec 14 12:13:19 2003
@@ -1,15 +1,16 @@
 ;;;;  -*- Mode: Lisp -*-
-;;;; $Id: logger.lisp,v 1.7 2003/12/14 16:10:29 krosenberg Exp $
+;;;; $Id: logger.lisp,v 1.8 2003/12/14 17:13:19 krosenberg Exp $
 ;;;;
 ;;;; Purpose: A logging bot 
 ;;;; Author:  Kevin Rosenberg
 ;;;; License: net-nittin-irc license
 
 (in-package cl-user)
-(defpackage logger
+(defpackage irc-logger
   (:use :common-lisp :irc :cl-ppcre)
-  (:export #:start-logger-bot))
-(in-package logger)
+  (:export #:add-logger
+	   #:quit-logger))
+(in-package irc-logger)
 
 (defclass channel ()
   ((name :initarg :name :reader name
@@ -92,6 +93,15 @@
     (:html
      (format (elt (streams channel) istream) "</body></html>~%"))))
 
+(defun log-file-directory (utime pathname)
+  (append (pathname-directory pathname)
+	  (list
+	   (multiple-value-bind
+		 (second minute hour day-of-month month year day-of-week daylight-p zone)
+	       (decode-universal-time utime)
+	     (declare (ignore second minute day-of-month hour day-of-week daylight-p zone))
+	     (format nil "~4,'0D-~2,'0D" year month)))))
+
 (defun ensure-output-stream-for-user-directory (utime logger channel istream)
   (let ((name (make-output-name (base-name channel) utime)))
     (unless (string= name (elt (current-output-names channel) istream))
@@ -99,7 +109,8 @@
 	(output-file-footer logger channel istream)
 	(close (elt (streams channel) istream)))
       (setf (elt (current-output-names channel) istream) name)
-      (let ((path (make-pathname :defaults (default-pathname channel) :name name
+      (let ((path (make-pathname :directory (log-file-directory utime (default-pathname channel))
+				 :name name
 				 :type (case (elt (formats logger) istream)
 					 (:html "html")
 					 (:sexp "sexp")