r8638: code cleanup, write logs by utc date

diff --git a/debian/changelog b/debian/changelog
index 39f4c288573efcaa450725cf77c46e6697f5d423..c85220d0c76ec80933c2ac808164f35d47cb6404 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+cl-irc-logger (0.8.0-1) unstable; urgency=low
+
+  * Extensive code cleanup
+  * Name log files by UTC rather than local time
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Sun,  8 Feb 2004 01:00:10 -0700
+
 cl-irc-logger (0.7.3-1) unstable; urgency=low
 
   * Fix bug with unknown/private streams

diff --git a/logger.lisp b/logger.lisp
index 64d94c3feb7fa6c98536c7640f88f766285702e7..deb4ba5c8f9f2488de3ec32494d1b14a37cbbf3a 100644 (file)
--- a/logger.lisp
+++ b/logger.lisp
@@ -91,11 +91,23 @@
     (format nil "~A-~4,'0D.~2,'0D.~2,'0D" (canonicalize-channel-name name)
            year month day))
 
+(defmacro with-decoding ((utime &optional zone) &body body)
+  `(multiple-value-bind
+    (second minute hour day-of-month month year day-of-week daylight-p zone)
+    (decode-universal-time ,utime ,@(if zone (list zone)))
+    (declare (ignorable second minute hour day-of-month month year day-of-week daylight-p zone))
+    ,@body))
+
+(defun format-utime (utime &optional zone)
+  (with-decoding (utime zone)
+    (format nil "~2,'0D:~2,'0D:~2,'0D" hour minute second)))
+
+(defun format-date-time (utime &key stream)
+  (with-decoding (utime)
+    (format stream "~4,'0D/~2,'0D/~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day-of-month hour minute second)))
+
 (defun make-output-name-utime (name utime)
-  (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 hour day-of-week daylight-p zone))
+  (with-decoding (utime 0)
     (make-output-name name year month day-of-month)))
 
 (defgeneric write-file-header (format channel-name stream))
@@ -137,11 +149,8 @@
 
 
 (defun log-file-path-utime (output-root channel-name format utime)
-  (multiple-value-bind
-       (second minute hour day month year day-of-week daylight-p zone)
-      (decode-universal-time utime)
-    (declare (ignore second minute hour day-of-week daylight-p zone))
-    (log-file-path output-root channel-name year month day format)))
+  (with-decoding (utime 0)
+    (log-file-path output-root channel-name year month day-of-month format)))
 
 (defun get-stream (channel istream)
   (elt (streams channel) istream))
@@ -197,27 +206,6 @@
        (open (user-output logger) :direction :output :if-exists :append
              :if-does-not-exist :create)))))))
 
-(defun format-date-time (utime)
-  (multiple-value-bind
-       (second minute hour day-of-month month year day-of-week daylight-p zone)
-      (decode-universal-time utime)
-    (declare (ignore day-of-week daylight-p zone))
-    (format nil "~4,'0D/~2,'0D/~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day-of-month hour minute second)))
-
-(defun format-utime (utime)
-  (multiple-value-bind
-       (second minute hour day-of-month month year day-of-week daylight-p zone)
-      (decode-universal-time utime)
-    (declare (ignore day-of-month month year day-of-week daylight-p zone))
-    (format nil "~2,'0D:~2,'0D:~2,'0D" hour minute second)))
-
-(defun format-utime-short (utime)
-  (multiple-value-bind
-       (second minute hour day-of-month month year day-of-week daylight-p zone)
-      (decode-universal-time utime)
-    (declare (ignore second day-of-month month year day-of-week daylight-p zone))
-    (format nil "~2,'0D:~2,'0D" hour minute)))
-
 (defun user-address (msg)
   (let ((split (split *user-address-scanner* (raw-message-string msg)
                      :with-registers-p t)))
@@ -277,7 +265,7 @@
 
 (defmethod %output-event ((format (eql :text)) stream utime type channel
                          source text msg unichannel)
-  (format stream "~A " (format-utime utime))
+  (format stream "~A " (format-utime utime 0))
   (when (and (null unichannel) channel)
     (format stream "[~A] " channel))
   
@@ -321,11 +309,10 @@
   (force-output (get-stream channel istream)))
 
 (defun log-daemon-message (logger fmt &rest args)
-  (let ((text (apply #'format nil fmt args))
-       (time (get-universal-time)))
-    (format (get-private-log-stream logger)
-           "~A ~A~%" (format-date-time time) text)
-    (force-output (get-private-log-stream logger))
+  (let ((text (apply #'format nil fmt args)))
+    (add-private-log-entry logger "~A" text)
+    ;;don't daemon messages to the logs
+    #+ignore
     (dolist (channel (channels logger))
       (dotimes (istream (length (formats logger)))
        (ensure-output-stream time logger channel istream)
@@ -341,11 +328,7 @@
   (dolist (logger *loggers*)
     (case type
       ((:error :server :kill)
-       (format (get-private-log-stream logger)
-              "~A ~A~%"
-              (format-date-time (received-time msg))
-              (raw-message-string msg))
-       (force-output (get-private-log-stream logger)))
+       (add-private-log-entry logger "~A" (raw-message-string msg)))
       ((:quit :nick)
        ;; send to all channels that a nickname is joined
        (let* ((user (find-user (connection logger)
@@ -376,17 +359,22 @@
       (unknown-log-stream logger)
     *standard-output*))
 
+(defun add-log-entry (stream fmt &rest args)
+  (format-date-time (get-universal-time) :stream stream)
+  (write-char #\space stream)
+  (apply #'format stream fmt args)
+  (write-char #\newline stream)
+  (force-output stream))
+
+(defun add-private-log-entry (logger fmt &rest args)
+  (apply #'add-log-entry (get-private-log-stream logger) fmt args))
+
 (defun privmsg-hook (msg)
   (let ((logger (find-logger-with-connection (connection msg)))
        (channel (first (arguments msg))))
     (cond
      ((equal channel (nickname logger))
-      (format
-       (get-private-log-stream logger)
-       "~A ~A~%" 
-       (format-date-time (get-universal-time))
-       (raw-message-string msg))
-      (force-output (get-private-log-stream logger)))
+      (add-private-log-entry logger "~A" (raw-message-string msg)))
      (t
       (output-event msg :privmsg channel (trailing-argument msg))))))
 
@@ -413,24 +401,14 @@
        (who-kicked (second (arguments msg))))
     (output-event msg :kick channel who-kicked)
     (when (string-equal (nickname logger) who-kicked)
-      (format
-       (get-private-log-stream logger)
-       "~A Logging daemon ~A has been kicked from ~A (~A)~%"
-       (format-date-time (received-time msg))
-       (nickname logger)
-       channel
-       (trailing-argument msg))
-      (force-output (get-private-log-stream logger))
+      (add-private-log-entry
+       "Logging daemon ~A has been kicked from ~A (~A)"
+       (nickname logger) channel (trailing-argument msg))
       (daemon-sleep 1)
       (remove-channel-logger logger channel)
       (daemon-sleep 1)
       (add-channel-logger logger channel)
-      (format
-       (get-private-log-stream logger)
-       "~A Rejoined ~A~%"
-       (format-date-time (received-time msg))
-       channel)
-      (force-output (get-private-log-stream logger)))))
+      (add-private-log-entry logger "Rejoined ~A" channel))))
 
 (defun notice-hook (msg)
   (let ((logger (find-logger-with-connection (connection msg)))
@@ -441,17 +419,9 @@
            (string-equal "owned by someone else" (trailing-argument msg)))
        (if logger
           (privmsg (connection msg) (source msg) (format nil "IDENTIFY ~A" (password logger)))
-        (format
-         (get-private-log-stream logger)
-         "~A NickServ asks for identity with connection not found.~%"
-         (format-date-time (received-time msg)))))
+        (add-private-log-entry logger "NickServ asks for identity with connection not found.")))
       ((equal channel (nickname logger))
-       (format
-       (get-private-log-stream logger)
-       "~A ~A~%" 
-       (format-date-time (get-universal-time))
-       (raw-message-string msg))
-       (force-output (get-private-log-stream logger)))
+       (add-private-log-entry logger "~A" (raw-message-string msg)))
       (t
        (output-event msg :notice channel (trailing-argument msg))))))
 
@@ -492,12 +462,7 @@
 
 (defun invite-hook (msg)
   (let ((logger (find-logger-with-connection (connection msg))))
-    (format 
-     (get-private-log-stream logger)
-     "~A ~A~%"
-     (format-date-time (get-universal-time))
-     (raw-message-string msg))
-    (force-output (get-private-log-stream logger))))
+    (add-private-log-entry logger "~A" (raw-message-string msg))))
 
 
 (defun make-a-channel (name formats output)
@@ -562,13 +527,9 @@
        ;; nothing to do
        )
       (t
-       (let ((logger (find-logger-with-connection (connection msg))))
-        (format (get-unknown-log-stream
-                 (find-logger-with-connection (connection msg)))
-                "~A ~A~%"
-                (format-date-time (received-time msg ))
-                (raw-message-string msg))
-        (force-output (get-unknown-log-stream logger)))))
+       (add-log-entry
+       (get-unknown-log-stream (find-logger-with-connection (connection msg)))
+       (raw-message-string msg))))
     result))
 
 (defun create-logger (nick server &key channels output password
@@ -652,10 +613,8 @@
                                    (logging-stream t) (async t)
                                    (formats '(:sexp)))
   (when (find-logger-with-nick nick)
-    (format
-     (get-private-log-stream (find-logger-with-nick nick))
-     "~A Closing previously active connection [add-logger].~%"
-     (format-date-time (get-universal-time)))
+    (add-private-log-entry (find-logger-with-nick nick)
+                          "Closing previously active connection [add-logger].")
     (ignore-errors (remove-logger nick)))
   (let ((logger (create-logger nick server :channels channels :output output
                               :logging-stream logging-stream :password password
@@ -671,11 +630,7 @@
 (defun add-channel-logger (logger channel-name)
   (cond
     ((find-channel-with-name logger channel-name)
-     (format (get-private-log-stream logger)
-            "~A Channel ~A already in logger ~A.~%" 
-            (format-date-time (get-universal-time))
-            channel-name logger)
-     (force-output (get-private-log-stream logger))
+     (add-private-log-entry logger "Channel ~A already in logger ~A." channel-name logger)
      nil)
     (t
      (let ((channel (make-a-channel channel-name (formats logger) (user-output logger))))
@@ -699,11 +654,8 @@
                                            :test #'string-equal))
        t)
       (t
-       (format
-       (get-private-log-stream logger)
-       "~A Channel name ~A not found in logger ~A.~%" 
-       (format-date-time (get-universal-time)) 
-       channel-name logger)
+       (add-private-log-entry
+       logger "Channel name ~A not found in logger ~A." channel-name logger)
        nil))))
 
 (defun add-hook-logger (logger class hook)
@@ -720,11 +672,7 @@
     (when (and (stringp target)
               (string-equal target (nickname logger)))
       (setf (warning-message-utime logger) (received-time msg)))
-    (format (get-private-log-stream logger)
-           "~A Killed by ~A~%"
-           (format-date-time (received-time msg))
-           (source msg))
-    (force-output (get-private-log-stream logger))))
+    (add-private-log-entry logger "Killed by ~A" (source msg))))
 
 (defun error-hook (msg)
   (let ((text (trailing-argument msg))
@@ -751,21 +699,27 @@
   ;; avoid generating too many reconnect messages in the logs
   (when (or (null (warning-message-utime logger))
            (< (- (get-universal-time) (warning-message-utime logger)) 300))
-    (log-daemon-message logger "Disconnected. Attempting reconnection at ~A."
-                       (format-date-time (get-universal-time)))))
+    (log-daemon-message logger "Disconnected. Attempting reconnection.")))
 
 (defun log-reconnection (logger)
-  (log-daemon-message
-   logger
-   "Connection restablished at ~A." (format-date-time (get-universal-time))))
+  (log-daemon-message logger "Connection restablished."))
 
+#+ignore
 (defun is-connected (logger)
+  (%is-connected logger))
+
+(defun is-connected (logger)
+  #-allegro (%is-connected logger)
+  #+allegro (mp:with-timeout (60 nil)
+             (%is-connected logger)))
+
+(defun %is-connected (logger)
   (when (ignore-errors (ping (connection logger) (server logger)))
     (dotimes (i 20)
       (when (and (last-pong logger)
                 (< (- (get-universal-time) (last-pong logger)) 21))
-       (return-from is-connected t))
-      (sleep 1))))
+       (return-from %is-connected t))
+      (daemon-sleep 1))))
 
 
 (let (*recon-nick* *recon-server* *recon-username* *recon-realname*