enlivend ([info]enlivend) wrote,
@ 2007-07-19 16:47:00
Previous Entry  Add to memories!  Tell a Friend!  Next Entry
CL-LOG and delayed logs
So, in my last post I made untested claims about "specialised binary logs". This week I got to implement one. Interestingly, I only had to make one change to CL-LOG to get this to work: exporting the symbol TIMESTAMP so that code to read binary logs back in can forge backdated timestamps and recreate the original log in text form.

Slotted this into one of my applications and it just worked. Nice one. Slotted it into another and it tripped over its own feet on startup, about 50% of the time, with a race condition between the new binary messenger and another one which just has to be started up before and just has to run in a different thread. (Don't ask.) Solved this by implementing a "delayed log" messenger - this sits on every message to anywhere until you're ready to let them all go, and the messages then all go out in the right order and with the correct timestamps.

(defun queue-all-messages ()
  (start-messenger 'queue-messenger
                   :name 'queue-messenger))

(defclass queue-messenger (base-messenger)
  ((queue :reader queue-messenger-queue :initform (make-queue))))

(defmethod print-object ((self queue-messenger) stream)
  (print-unreadable-object (self stream :type t :identity t)
    (format stream "~d" (length (queue-queue (queue-messenger-queue self))))))

(defclass queued-message (base-message)
  ())

(defmethod messenger-send-message :around (messenger (message formatted-message))
  (let* ((log-manager (log-manager))
         (queue-messenger (find 'queue-messenger (log-manager-messengers log-manager) :key 'type-of))
         (queued-message (make-instance 'queued-message
                                        :timestamp :||
                                        :description messenger
                                        :arguments `(,message))))
    (enqueue queued-message (queue-messenger-queue queue-messenger))))

(defmethod messenger-send-message ((self queue-messenger) message)
  nil)

(defmethod stop-messenger :around ((self queue-messenger))
  (let* ((gf #'messenger-send-message)
         (method (find-method gf '(:around) (mapcar 'find-class '(t formatted-message)))))
    (remove-method gf method))
  (call-next-method)
  (dolist (queued-message (queue-queue (queue-messenger-queue self)))
    (messenger-send-message (message-description queued-message)
                            (car (message-arguments queued-message)))))


(Slot in your own definition of queues, or shove messages onto a list and reverse it.)


Create an Account
Forgot your login?
Login w/ OpenID
English • Español • Deutsch • Русский…