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

storage/folder: root, put-new

Browse source
This commit is contained in:
Helmut Merz 2024-08-08 15:28:31 +02:00
parent d673f6280c
commit d759a5c57c
3 changed files with 22 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
storage/folder.lisp
View file

@ -3,18 +3,19 @@
(defpackage :scopes/storage/folder (defpackage :scopes/storage/folder
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:shape :scopes/shape) (:local-nicknames (:shape :scopes/shape)
(:tracking :scopes/storage/tracking)) (:tracking :scopes/storage/tracking)
(:export #:folder (:util :scopes/util))
(:export #:folder #:root #:put-new
#:make-container)) #:make-container))
(in-package :scopes/storage/folder) (in-package :scopes/storage/folder)
(defclass folder (tracking:track) (defclass folder (tracking:track)
((shape:head-fields :initform '(:parent :name :ref)) ((shape:head-fields :initform '(:parentid :name :ref))
(tracking:key-fields :initform '(:parent :name)))) (tracking:key-fields :initform '(:parentid :name))))
(defun indexes (cont) (defun indexes (cont)
'((parent name ref) (ref))) '((parentid name ref) (ref)))
(defun make-container (storage) (defun make-container (storage)
(make-instance 'tracking:container (make-instance 'tracking:container
@ -23,3 +24,14 @@
:table-name :folders :table-name :folders
:index-factory #'indexes :index-factory #'indexes
:storage storage)) :storage storage))
(defun root (cont)
(let ((f (tracking:make-item cont nil :root)))
(tracking:save f)))
(defun put-new (name parent)
(let* ((cont (tracking:container parent))
(pid (write-to-string (tracking:trackid parent)))
(f (tracking:make-item cont pid name)))
(util:lgi pid f)
(tracking:save f)))

2
test/test-core.lisp
View file

@ -54,9 +54,9 @@
(unwind-protect (unwind-protect
(progn (progn
(test-util) (test-util)
(test-record)
(core:setup-services) (core:setup-services)
(setf (receiver t:*test-suite*) (core:find-service :test-receiver)) (setf (receiver t:*test-suite*) (core:find-service :test-receiver))
(test-record)
(test-send)) (test-send))
(core:shutdown) (core:shutdown)
(check-expected) (check-expected)

5
test/test-storage.lisp
View file

@ -88,5 +88,8 @@
(setf cont (folder:make-container st)) (setf cont (folder:make-container st))
(storage:drop-table st :folders) (storage:drop-table st :folders)
(tracking:create-table cont) (tracking:create-table cont)
;(setf root (folder:root)) (setf root (folder:root cont))
(== (tracking:trackid root) 1)
(== (shape:head-value root :parentid) nil)
(setf f1 (folder:put-new :child1 root))
)) ))