cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

get-track basically working

Browse source
This commit is contained in:
Helmut Merz 2024-05-18 09:16:09 +02:00
parent 3b3cfaf732
commit e0e65efa39
3 changed files with 17 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
storage/storage.lisp
View file

@ -11,7 +11,7 @@
#:db-options #:db-params #:qualified-table-name #:db-options #:db-params #:qualified-table-name
#:do-sql #:query #:drop-table #:do-sql #:query #:drop-table
#:schema #:schema
#:normalize-plist)) #:normalize-keyword #:normalize-plist))
(in-package :scopes/storage) (in-package :scopes/storage)
@ -90,7 +90,7 @@
;;;; utilities ;;;; utilities
(defun normalize-keyword (kw) (defun normalize-keyword (kw)
(intern (string-upcase (symbol-name kw)) :keyword)) (intern (string-upcase kw) :keyword))
(defun normalize-plist (pl) (defun normalize-plist (pl)
(let ((res nil)) (let ((res nil))

14
storage/tracking.lisp
View file

@ -54,7 +54,6 @@
(storage:timestamp-to-sql (engine track) ts))) (storage:timestamp-to-sql (engine track) ts)))
(if data (setf (getf vl :data) (jzon:stringify data)))) (if data (setf (getf vl :data) (jzon:stringify data))))
vl)) vl))
(defun insert (track) (defun insert (track)
(ensure-timestamp track) (ensure-timestamp track)
@ -72,11 +71,20 @@
(let* ((st (storage cont)) (let* ((st (storage cont))
(table (storage:qualified-table-name st (table-name cont))) (table (storage:qualified-table-name st (table-name cont)))
(cols (append (head-fields cont) '(:timestamp :data))) (cols (append (head-fields cont) '(:timestamp :data)))
(res (storage:normalize-plist (car (storage:query st (row (storage:normalize-plist (car (storage:query st
(sxql:select cols (sxql:select cols
(sxql:from table) (sxql:from table)
(sxql:where (:= :trackid trid)))))))) (sxql:where (:= :trackid trid))))))))
res)) (build-track cont row)))
(defun build-track (cont row)
(let* ((hv (mapcar #'(lambda (x) (getf row x)) (head-fields cont)))
(tr (apply #'make-item cont hv)))
(setf (trackid tr) (getf row :trackid))
(setf (time-stamp tr) (getf row :timestamp))
(setf (data tr)
(jzon:parse (getf row :data) :key-fn #'storage:normalize-keyword))
tr))
(defun create-table (cont) (defun create-table (cont)
(let* (let*

6
test/test-storage.lisp
View file

@ -38,7 +38,7 @@
(t:show-result))) (t:show-result)))
(defun test-track (st) (defun test-track (st)
(let (cont tr (data (make-hash-table :test 'equalp))) (let (cont tr tr2 (data (make-hash-table)))
(setf cont (make-instance 'tracking:container :storage st)) (setf cont (make-instance 'tracking:container :storage st))
(storage:drop-table st :tracks) (storage:drop-table st :tracks)
(tracking:create-table cont) (tracking:create-table cont)
@ -50,5 +50,7 @@
(setf (tracking:data tr) data) (setf (tracking:data tr) data)
(tracking:insert tr) (tracking:insert tr)
(== (tracking:trackid tr) 1) (== (tracking:trackid tr) 1)
(print (tracking:get-track cont 1)) (setf tr2 (tracking:get-track cont 1))
(== (tracking:head tr2) '("t01" "john"))
(== (gethash :desc (tracking:data tr2)) "scopes/storage: queries")
)) ))