42 lines
1.4 KiB
Common Lisp
42 lines
1.4 KiB
Common Lisp
;;;; cl-scopes/storage/msgstore - storing message data in a SQL database
|
|
|
|
(defpackage :scopes/storage/msgstore
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:actor :scopes/core/actor)
|
|
(:core :scopes/core)
|
|
(:message :scopes/core/message)
|
|
(:shape :scopes/shape)
|
|
(:storage :scopes/storage)
|
|
(:tracking :scopes/storage/tracking))
|
|
(:export #:make-container #:save
|
|
#:replay-id
|
|
))
|
|
|
|
(in-package :scopes/storage/msgstore)
|
|
|
|
(defclass pmsg (message:message tracking:track)
|
|
((shape:meta :initform (shape:get-meta 'message:message) :allocation :class)))
|
|
|
|
(defun indexes (cont)
|
|
'((domain action class item) (domain class item)))
|
|
|
|
(defun make-container (storage)
|
|
(make-instance 'tracking:container
|
|
:item-class 'pmsg
|
|
:short-name :msg
|
|
:table-name :messages
|
|
:index-factory #'indexes
|
|
:force-insert-when :changed
|
|
:storage storage))
|
|
|
|
(defun save (msg cont)
|
|
(let ((pm (make-instance 'pmsg
|
|
:head (shape:head msg) :data (shape:data msg)
|
|
:container cont)))
|
|
(tracking:save pm)))
|
|
|
|
(defun replay-id (ctx msgid rcvr)
|
|
(let* ((st (storage:storage ctx))
|
|
(cont (make-container st))
|
|
(msg (tracking:get-track cont msgid)))
|
|
(actor:send (core:find-service rcvr) msg)))
|