tracking/storage: work in progress: folder

scopes.asd

@@ -8,7 +8,8 @@
   :description "Generic data processing."
   :depends-on (:scopes-core :scopes-web
                :dbi :sxql)
-  :components ((:file "storage/msgstore" :depends-on ("storage/tracking"))
+  :components ((:file "storage/folder" :depends-on ("storage/tracking"))
+               (:file "storage/msgstore" :depends-on ("storage/tracking"))
                (:file "storage/storage")
                (:file "storage/tracking" :depends-on ("storage/storage")))
   :long-description "scopes: generic data processing facilities."

storage/folder.lisp

@@ -0,0 +1,24 @@
+;;;; cl-scopes/storage/folder - persistent folders, stored in a SQL database.
+
+(defpackage :scopes/storage/folder
+  (:use :common-lisp)
+  (:local-nicknames (:shape :scopes/shape)
+                    (:tracking :scopes/storage/tracking))
+  (:export #:folder
+           #:make-container))
+
+(in-package :scopes/storage/folder)
+
+(defclass folder (tracking:track)
+  ((shape:head-fields :initform '(:parent :name :ref))))
+
+(defun indexes (cont)
+  '((parent name ref) (ref)))
+
+(defun make-container (storage)
+  (make-instance 'tracking:container 
+                 :item-class 'folder
+                 :short-name :fldr
+                 :table-name :folders
+                 :index-factory #'indexes
+                 :storage storage))

storage/tracking.lisp

@@ -1,6 +1,5 @@
-;;; cl-scopes/storage/tracking.lisp
+;;;; cl-scopes/storage/tracking - a simple generic (SQL-based) storage 
-
+;;;; for tracks, messages, and other stuff.
-;;;; A simple generic (SQL-based) storage for tracks, messages, and other stuff.
 
 (defpackage :scopes/storage/tracking
   (:use :common-lisp)
@@ -51,9 +50,6 @@
   (setf (gethash (short-name cont) *containers*) cont)
   (setf (item-head-fields cont) (shape:head-fields (make-instance (item-class cont)))))
 
-;(defun item-head-fields (cont)
-;  (shape:head-fields (make-instance (item-class cont))))
-
 (defun make-item (cont &rest head)
   (make-instance (item-class cont) :head head :container cont))
 
@@ -67,10 +63,14 @@
 
 (defun query-one (cont crit &key order-by)
   ;(util:lgd crit)
-  (let ((tr (make-item cont))
+  (let ((rows (storage:query (storage cont)
-        (row (car (storage:query (storage cont)
+                (setup-select cont crit :order-by order-by :limit 1))))
-                    (setup-select cont crit :order-by order-by :limit 1)))))
+    (setup-track (make-item cont) (car rows))))
-    (setup-track tr row)))
+
+(defun query (cont crit &key order-by)
+  (let ((rows (storage:query (storage cont)
+               (setup-select cont crit :order-by order-by))))
+    (mapcar #'(lambda (row) (setup-track (make-item cont) row)) rows)))
 
 (defun save (track)
   (let* ((cont (container track))

test/test-storage.lisp

@@ -6,6 +6,7 @@
   (:use :common-lisp)
   (:local-nicknames (:config :scopes/config)
                     (:core :scopes/core)
+                    (:folder :scopes/storage/folder)
                     (:logging :scopes/logging)
                     (:message :scopes/core/message)
                     (:msgstore :scopes/storage/msgstore)
@@ -39,6 +40,7 @@
   (let ((ctx (core:find-service :storage)))
     (test-track ctx)
     (test-msgstore ctx)
+    (test-folder ctx)
     (t:show-result)))
 
 (deftest test-track (ctx)
@@ -78,3 +80,12 @@
     (setf (getf (shape:data pm3) :info) "changed")
     (msgstore:save pm3 cont)
     ))
+
+(deftest test-folder (ctx)
+  (let ((st (storage:storage ctx))
+        (data (make-hash-table))
+        cont f1 f2 f3)
+    (setf cont (folder:make-container st))
+    (storage:drop-table st :folders)
+    (tracking:create-table cont)
+    ))