From a965224d14cf77adbe25556368af633b7468f924 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 8 Feb 2004 11:17:45 +0000 Subject: [PATCH] r8638: code cleanup, write logs by utc date --- debian/changelog | 7 ++ logger.lisp | 174 +++++++++++++++++------------------------------ 2 files changed, 71 insertions(+), 110 deletions(-) diff --git a/debian/changelog b/debian/changelog index 39f4c28..c85220d 100644 --- 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 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 64d94c3..deb4ba5 100644 --- 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* -- 2.34.1