storage/msglog: insert basically OK

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))

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)))

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))))

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))
     ))