diff --git a/scopes.asd b/scopes.asd index e330fff..bb27b01 100644 --- a/scopes.asd +++ b/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." diff --git a/storage/folder.lisp b/storage/folder.lisp new file mode 100644 index 0000000..3d256ef --- /dev/null +++ b/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)) diff --git a/storage/tracking.lisp b/storage/tracking.lisp index b25ed64..7300d77 100644 --- a/storage/tracking.lisp +++ b/storage/tracking.lisp @@ -1,6 +1,5 @@ -;;; cl-scopes/storage/tracking.lisp - -;;;; A simple generic (SQL-based) storage for tracks, messages, and other stuff. +;;;; cl-scopes/storage/tracking - 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)) - (row (car (storage:query (storage cont) - (setup-select cont crit :order-by order-by :limit 1))))) - (setup-track tr row))) + (let ((rows (storage:query (storage cont) + (setup-select cont crit :order-by order-by :limit 1)))) + (setup-track (make-item cont) (car rows)))) + +(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)) diff --git a/test/test-storage.lisp b/test/test-storage.lisp index f4bf796..95c386e 100644 --- a/test/test-storage.lisp +++ b/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) + ))