fix util:rtrim; work in progress: tracking:save

storage/tracking.lisp

@@ -52,6 +52,16 @@
   (query1 cont (make-where (list (list :trackid trid)))))
   ;(query1 cont (list := :trackid trid)))
 
+(defun save (cont track)
+  (let ((*build-track-data* #'identity)
+        (tr0 (query-last cont (shape:head-plist track)))
+        (new-data (alx:plist-hash-table (shape:data track))))
+    (if tr0
+      (if (equalp (shape:data tr0) new-data)
+        nil ; or insert <= insert-when == :always
+        (update track new-data)) ; or insert <= insert-when == :changed
+      (insert track new-data))))
+
 (defun query1 (cont crit)
   (let* ((tr (make-item cont))
          (st (storage cont))
@@ -65,25 +75,25 @@
              (sxql:limit 1)))))))
     (setup-track tr row)))
 
-(defun insert (track)
+(defun insert (track &optional data)
   (ensure-timestamp track)
   (let* ((cont (container track))
          (st (storage cont))
          (table (storage:qualified-table-name st (table-name cont)))
          (res (car (storage:query st
            (sxql:insert-into table
-             (apply #'sxql:make-clause ':set= (plist track))
+             (apply #'sxql:make-clause ':set= (plist track data))
              (sxql:returning :trackid))))))
     (setf (trackid track) (cadr res))
     track))
 
-(defun update (track)
+(defun update (track &optional data)
   (ensure-timestamp track)
   (let* ((cont (container track))
          (st (storage cont))
          (table (storage:qualified-table-name st (table-name cont))))
     (sxql:update table
-      (apply #'sxql:make-clause ':set= (plist track))
+      (apply #'sxql:make-clause ':set= (plist track data))
       (where (:= :trackid (trackid track))))))
 
 ;;;; auxiliary functions for queries, ...
@@ -118,9 +128,10 @@
   (if (not (time-stamp track))
     (setf (time-stamp track) (get-universal-time))))
 
-(defun plist (track)
+(defun plist (track &optional data)
-  (let ((vl (shape:head-plist track)))
+  (let ((vl (shape:head-plist track))
-    (with-slots ((trid trackid) (ts time-stamp) (data shape:data)) track
+        (data (or data (shape:data track))))
+    (with-slots ((trid trackid) (ts time-stamp)) track
       (when trid (setf (getf vl :trackid) trid))
       (when ts (setf (getf vl :timestamp) (timestamp-to-sql track ts)))
       (when data

test/test-core.lisp

@@ -62,7 +62,7 @@
       (t:show-result))))
 
 (deftest test-util ()
-  (== (util:rtrim '(1 2 nil 3 nil)) '(1 2)) 
+  (== (util:rtrim '(1 2 nil 3 nil)) '(1 2 nil 3)) 
   (== (util:to-keyword "hello-kitty") :hello-kitty)
   (== (util:loop-plist '(:a "a" :b "b") k v collect (string-upcase k)) '("A" "B")))
 

util.lisp

@@ -12,8 +12,7 @@
 ;;;; lists and loops
 
 (defun rtrim (lst)
-  (if (car lst)
+  (nreverse (member-if #'identity (reverse lst))))
-    (cons (car lst) (rtrim (cdr lst)))))
 
 (defmacro loop-plist (plist kvar vvar &body body)
   `(loop for (,kvar ,vvar . nil) on ,plist by #'cddr ,@body))