diff --git a/shape/shape.lisp b/shape/shape.lisp index 44e130d..4064294 100644 --- a/shape/shape.lisp +++ b/shape/shape.lisp @@ -14,7 +14,9 @@ (data :accessor data :initarg :data :initform nil))) (defun head-plist (track) - (let (pl (hv (head track))) + (let (pl h (hv (head track))) (dolist (hf (head-fields track)) - (setf (getf pl hf) (or (pop hv) ""))) + (setf h (pop hv)) + (setf (getf pl hf) + (if h (string-downcase h) ""))) pl)) diff --git a/storage/msglog.lisp b/storage/msglog.lisp index ab2d0d7..79235d6 100644 --- a/storage/msglog.lisp +++ b/storage/msglog.lisp @@ -3,6 +3,7 @@ (defpackage :scopes/storage/msglog (:use :common-lisp) (:local-nicknames (:message :scopes/core/message) + (:shape :scopes/shape) (:storage :scopes/storage) (:tracking :scopes/storage/tracking)) (:export #:make-container #:save)) @@ -15,5 +16,12 @@ (make-instance 'tracking:container :item-class 'pmsg :table-name :messages - :indexes '((domain action class item)) + :indexes '((domain action class item) + (domain class item)) :storage storage)) + +(defun save (msg cont) + (let ((pm (make-instance 'pmsg + :head (shape:head msg) :data (shape:data msg) + :container cont))) + (tracking:insert pm))) diff --git a/storage/storage.lisp b/storage/storage.lisp index e0f2ce2..1fd5939 100644 --- a/storage/storage.lisp +++ b/storage/storage.lisp @@ -63,7 +63,6 @@ (defun query (st spec) (multiple-value-bind (sql args) (sxql:yield spec) - ;(print sql) (let* ((qp (dbi:prepare (conn st) sql)) (qx (dbi:execute qp args))) (dbi:fetch-all qx)))) diff --git a/test/test-storage.lisp b/test/test-storage.lisp index cab85b3..3006aa1 100644 --- a/test/test-storage.lisp +++ b/test/test-storage.lisp @@ -62,8 +62,10 @@ (deftest test-msglog (ctx) (let ((st (storage:storage ctx)) (data (make-hash-table)) - cont msg) + cont msg pm) (setf cont (msglog:make-container st)) (storage:drop-table st :messages) (tracking:create-table cont) + (setf msg (message:create '(:test :data :field :info) :data '(:info "test data"))) + (setf pm (msglog:save msg cont)) ))