/pliant/storage/database/mount.pli
1	abstract
2	[This will handle the tree that is used to provide all databases as a single datas tree, just like in Unix, all files in all filesystems are provided as a single tree.]
3
4	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
5	#
6	# This program is free software; you can redistribute it and/or
7	# modify it under the terms of the GNU General Public License version 2
8	# as published by the Free Software Foundation.
9	#
10	# This program is distributed in the hope that it will be useful,
11	# but WITHOUT ANY WARRANTY; without even the implied warranty of
12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13	# GNU General Public License for more details.
14	#
15	# You should have received a copy of the GNU General Public License
16	# version 2 along with this program; if not, write to the Free Software
17	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
18
19	scope "/pliant/storage/" "/pliant/appli/"
20	module "/pliant/language/compiler.pli"
21	module "/pliant/util/encoding/html.pli"
22	module "prototype.pli"
23
24
25
26
27
28	type DataMount
29	void
30
31	DataInterface_ maybe DataMount
32
33
34	method dm search d k -> d2
35	oarg DataMount dm ; arg Data_ d ; arg Str k ; arg Data_ d2
36	var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) first k
37	if exists:cursor
38	if entry_type:cursor=(Index Str Arrow)
39	d2 adr := cursor
40	d2 object := cursor
41	d2 interface :> d interface
42	else
43	(cursor omap Database_) get_root d2
44	return
45	else
46	d2 := data_null
47	d2 base :> d base
48	d2 path1 :> new Str d:dbpath+"/"+html_encode:k
49	d2 path2 :> null map Str
50
51	method dm first d start stop buf -> d2
52	oarg DataMount dm ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2
53	var Pointer:Arrow cursor
54	if start:len=0
55	cursor :> (d:adr map (Index Str Arrow)) first
56	else
57	cursor :> (d:adr map (Index Str Arrow)) from start
58	if not exists:cursor
59	d2 adr := null
60	return
61	if entry_type:cursor=(Index Str Arrow)
62	d2 adr := cursor
63	d2 object := cursor
64	d2 interface :> d interface
65	else
66	(cursor omap Database_) get_root d2
67	d2 path1 :> new Str d:dbpath+"/"+html_encode:((d:adr map (Index Str Arrow)) key cursor)
68	d2 path2 :> null map Str
69	buf adr := addressof cursor
70
71	method dm next d start stop buf -> d2
72	oarg DataMount dm ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2
73	var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) next (buf:adr map Arrow)
74	if not exists:cursor
75	d2 adr := null
76	return
77	if stop:len>0 and ((d:adr map (Index Str Arrow)) key cursor)>=stop
78	d2 adr := null
79	return
80	if entry_type:cursor=(Index Str Arrow)
81	d2 adr := cursor
82	d2 object := cursor
83	d2 interface :> d interface
84	else
85	(cursor omap Database_) get_root d2
86	d2 path1 :> new Str d:dbpath+"/"+html_encode:((d:adr map (Index Str Arrow)) key cursor)
87	d2 path2 :> null map Str
88	buf adr := addressof cursor
89
90	method dm count d start stop -> count
91	oarg_rw DataMount dm ; arg Data_ d ; arg Str start stop ; arg Int count
92	var Pointer:Index_ idx :> d:adr map Index_
93	if start:len=0 and stop:len=0
94	count := (d:adr map (Index Str Arrow)) size
95	else
96	# FIXME
97	void
98
99
100	method dm create d k -> status
101	oarg_rw DataMount dm ; arg_rw Data_ d ; arg Str k; arg Status status
102	var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) first k
103	if not exists:cursor
104	var Arrow a := entry_new (Index Str Arrow)
105	(d:adr map (Index Str Arrow)) insert k a
106	status := success
107	else
108	status := failure
109
110	method dm delete d k -> status
111	oarg_rw DataMount dm ; arg_rw Data_ d ; arg Str k; arg Status status
112	var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) first k
113	if exists:cursor
114	(d:adr map (Index Str Arrow)) remove cursor
115	status := success
116	else
117	status := failure
118
119
120
121
122	type DatabaseMount
123	field Database_ common
124	field Sem real_sem
125
126	Database_ maybe DatabaseMount
127
128
129	function build dm
130	arg_w DatabaseMount dm
131	dm:common sem :> dm real_sem
132
133	gvar DatabaseMount database_root
134
135	gvar Data_ data_root := data_null
136	data_root object := entry_new (Index Str Arrow)
137	data_root adr := data_root object
138	data_root interface :> new DataMount
139	data_root base :> database_root
140	data_root path1 :> ""
141	data_root path2 :> null map Str
142
143	method dm get_root d
144	arg DatabaseMount dm ; arg_w Data_ d
145	d := data_root
146
147
148	function data_mount db path
149	oarg_rw Database_ db ; arg Str path
150	data_root:base:sem request
151	db path := path
152	var Str p := path
153	var Data_ d := data_root
154	while (p parse "/" any:(var Str k) "/" any:(var Str remain))
155	var Data_ d2 := d:interface search d html_decode:k true
156	d := d2 ; p := "/"+remain
157	if (p parse "/" any:(var Str k))
158	var Pointer:(Index Str Arrow) index :> d:adr map (Index Str Arrow)
159	var Pointer:Arrow c :> index first html_decode:k
160	if exists:c
161	if entry_type:c<>(Index Str Arrow)
162	(c map Database_) path := ""
163	index remove c
164	var Arrow a := addressof db
165	index insert html_decode:k a
166	data_root:base:sem release
167
168
169	function data_umount path -> status
170	arg Str path ; arg Status status
171	database_root:sem request
172	var Str p := path
173	var Data_ d := data_root
174	while (p parse "/" any:(var Str k) "/" any:(var Str remain))
175	var Data_ d2 := d:interface search d html_decode:k false
176	d := d2 ; p := "/"+remain
177	if (p parse "/" any:(var Str k))
178	status := d:interface delete d html_decode:k
179	if (d:interface count d "" "")=0
180	data_root:base:sem release
181	data_umount (path 0 (path search_last "/" 0))
182	return
183	else
184	status := failure
185	database_root:sem release
186
187
188	export data_root
189	export data_mount data_umount