/pliant/storage/database/inmemory.pli
1	abstract
2	[The methods used to access datas stored in the main memory.]
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/language/data/string_cast.pli"
22	module "/pliant/util/encoding/html.pli"
23	module "prototype.pli"
24	module "interface.pli"
25	module "set.pli"
26
27	public
28
29
30
31
32
33	type DataField
34	field Link:Type type
35
36	DataInterface_ maybe DataField
37
38
39	method df type d -> t
40	oarg DataField df ; arg Data_ d ; arg_R Type t
41	t :> df type
42
43	method df get d adr type -> status
44	oarg DataField df ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status
45	if type=df:type
46	type copy_instance d:adr adr
47	status := success
48	else
49	var Str s := to_string d:adr df:type "db"
50	status := from_string adr type s "db"
51
52	method df set d adr type -> status
53	oarg_rw DataField df ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status
54	if type=df:type
55	type copy_instance adr d:adr
56	status := success
57	else
58	var Str s := to_string adr type "db"
59	status := from_string d:adr df:type s "db"
60	if status=success
61	d:base notify_set d d:adr df:type
62
63	method df get_raw d adr type -> status
64	oarg DataField df ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status
65	if type=df:type
66	type copy_instance d:adr adr
67	status := success
68	else
69	var Str s := to_string d:adr df:type "raw"
70	status := from_string adr type s "raw"
71
72	method df set_raw d adr type -> status
73	oarg_rw DataField df ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status
74	if type=df:type
75	type copy_instance adr d:adr
76	status := success
77	else
78	var Str s := to_string adr type "raw"
79	status := from_string d:adr df:type s "raw"
80	if status=success
81	d:base notify_set d d:adr df:type
82
83	method df reset d -> status
84	oarg_rw DataField df ; arg_rw Data_ d ; arg Status status
85	df:type destroy_instance d:adr
86	df:type build_instance d:adr
87	d:base notify_reset d
88	status := success
89
90
91
92
93
94	type DataRecordFieldDef
95	field Pointer:DataInterface_ record_interface
96	field Int offset
97	field Link:DataInterface_ interface
98	field Str path
99	field Arrow default
100
101	type DataRecord
102	field Link:Type type
103	field Dictionary fields
104	field List all_fields
105
106	DataInterface_ maybe DataRecord
107
108
109	method dr reset d -> status
110	oarg_rw DataRecord dr ; arg_rw Data_ d ; arg Status status
111	dr:type destroy_instance d:adr
112	dr:type build_instance d:adr
113	d:base notify_reset d
114	status := success
115
116
117	method f apply d d2
118	arg DataRecordFieldDef f ; arg Data_ d ; arg_w Data_ d2
119	d2 adr := d:adr translate Byte f:offset
120	d2 object := d object
121	d2 interface :> f interface
122	d2 base :> d base
123	if (addressof d:path2)=null
124	d2 path1 :> d path1
125	d2 path2 :> f path
126	else
127	d2 path1 :> new Str d:path1+d:path2+f:path
128	d2 path2 :> null map Str
129
130	method dr search d k -> d2
131	oarg DataRecord dr ; arg Data_ d ; arg Str k ; arg Data_ d2
132	var Pointer:Arrow a :> dr:fields first k
133	if a<>null
134	(a map DataRecordFieldDef) apply d d2
135	else
136	d2 := data_null
137	d2 base :> d base
138	d2 path1 :> new Str d:dbpath+"/"+html_encode:k
139	d2 path2 :> null map Str
140
141	method dr next d start stop buf -> d2
142	oarg DataRecord dr ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2
143	var Pointer:Arrow a
144	if buf:adr<>null
145	a :> dr:all_fields next (buf:adr map Arrow)
146	else
147	a :> dr:all_fields first
148	while a<>null
149	var Pointer:DataRecordFieldDef f :> a map DataRecordFieldDef
150	if (start:len=0 or html_decode:(f:path 1 f:path:len)>=start) and (stop:len=0 or html_decode:(f:path 1 f:path:len)<stop)
151	f apply d d2
152	buf adr := addressof a
153	return
154	a :> dr:all_fields next a
155	d2 adr := null
156
157	method dr first d start stop buf -> d2
158	oarg DataRecord dr ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2
159	buf adr := null
160	d2 := dr next d start stop buf
161
162	method dr count d start stop -> count
163	oarg_rw DataRecord dr ; arg Data_ d ; arg Str start stop ; arg Int count
164	if start:len=0 and stop:len=0
165	count := dr:fields count
166	else
167	count := 0
168	var Pointer:Arrow c :> dr:all_fields first
169	while c<>null
170	var Pointer:DataRecordFieldDef f :> c map DataRecordFieldDef
171	if (start:len=0 or html_decode:(f:path 1 f:path:len)>=start) and (stop:len=0 or html_decode:(f:path 1 f:path:len)<stop)
172	count += 1
173	c :> dr:all_fields next c
174
175	if false
176	method dr set d adr type -> status
177	oarg_rw DataRecord dr ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status
178	if type=Str and (adr map Str)=""
179	dr:type destroy_instance d:adr
180	dr:type build_instance d:adr
181	status := success
182	else
183	status := failure
184
185
186
187
188
189	type DataTable
190	field Link:DataInterface_ value_interface
191	field Link:Type value_type
192	field Link:Type node_type
193
194	DataInterface_ maybe DataTable
195
196
197	method dt reset d -> status
198	oarg_rw DataTable dt ; arg_rw Data_ d ; arg Status status
199	var Pointer:Index_ idx :> d:adr map Index_
200	idx reset dt:node_type true
201	d:base notify_reset d
202	status := success
203
204
205	method dt search d k -> d2
206	oarg DataTable dt ; arg Data_ d ; arg Str k ; arg Data_ d2
207	var Pointer:Index_ idx :> d:adr map Index_
208	var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
209	if cursor<>null
210	d2 adr := cursor
211	d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
212	d2 interface :> dt value_interface
213	else
214	d2 := data_null
215	d2 base :> d base
216	d2 path1 :> new Str d:dbpath+"/"+html_encode:k
217	d2 path2 :> null map Str
218
219	method dt first d start stop buf -> d2
220	oarg DataTable dt ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2
221	var Pointer:Index_ idx :> d:adr map Index_
222	var Address cursor
223	if start:len=0
224	cursor := idx first IndexNode_:size+Str:size
225	else
226	cursor := idx from addressof:start (the_function compare Str Str -> Int) IndexNode_:size+Str:size
227	d2 adr := cursor
228	if cursor<>null
229	d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
230	d2 interface :> dt value_interface
231	d2 base :> d base
232	var Pointer:Str k :> (cursor translate Str -1) map Str
233	d2 path1 :> new Str d:dbpath+"/"+html_encode:k
234	d2 path2 :> null map Str
235	buf adr := cursor
236
237	method dt next d start stop buf -> d2
238	oarg DataTable dt ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2
239	var Pointer:Index_ idx :> d:adr map Index_
240	if (idx is_deleted buf:adr IndexNode_:size+Str:size)
241	var Str key := (buf:adr translate Str -1) map Str
242	# console "automatic recovery of deleted key " key eol
243	d2 := dt first d key stop buf
244	if d2:adr<>null and d2:key=key
245	d2 := dt next d start stop buf
246	return
247	var Address cursor := idx next buf:adr IndexNode_:size+Str:size
248	if cursor=null
249	d2 adr := null
250	return
251	var Pointer:Str k :> (cursor translate Str -1) map Str
252	if stop:len>0 and k>=stop
253	d2 adr := null
254	return
255	d2 adr := cursor
256	d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
257	d2 interface :> dt value_interface
258	d2 base :> d base
259	var Pointer:Str k :> (cursor translate Str -1) map Str
260	d2 path1 :> new Str d:dbpath+"/"+html_encode:k
261	d2 path2 :> null map Str
262	buf adr := cursor
263
264	method dt count d start stop -> count
265	oarg_rw DataTable dt ; arg Data_ d ; arg Str start stop ; arg Int count
266	var Pointer:Index_ idx :> d:adr map Index_
267	if start:len=0 and stop:len=0
268	count := idx size
269	else
270	# highly suboptimal implementation
271	count := 0
272	var Data_ cur := dt first d start stop (var DataScanBuffer buf)
273	while cur:adr<>null
274	var Data_ cur := dt next d start stop buf
275	count += 1
276
277
278	method dt create d k -> status
279	oarg_rw DataTable dt ; arg_rw Data_ d ; arg Str k; arg Status status
280	var Pointer:Index_ idx :> d:adr map Index_
281	var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
282	if cursor=null
283	idx insert addressof:k false null (the_function compare Str Str -> Int) Str:size+IndexNode_:size Str dt:value_type dt:node_type true
284	d:base notify_create d k
285	status := success
286	else
287	status := failure
288
289	method dt delete d k -> status
290	oarg_rw DataTable dt ; arg_rw Data_ d ; arg Str k; arg Status status
291	var Pointer:Index_ idx :> d:adr map Index_
292	var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
293	if cursor<>null
294	dt:value_interface pre_delete d k
295	idx remove cursor IndexNode_:size+Str:size dt:node_type true
296	d:base notify_delete d k
297	status := success
298	else
299	status := failure
300
301
302
303
304
305	type Anything
306	field Str value
307	field Index_ index
308
309	(addressof:Anything map Type) flags := Anything:flags .or. type_flag_field
310
311	type AnythingNode
312	field IndexNode_ node
313	field Str key
314	field Anything value
315
316	type DataAnything
317	field Link:DataInterface_ value_interface
318	field Link:Type value_type
319	field Link:Type node_type
320
321	DataInterface_ maybe DataAnything
322
323	function destroy a
324	arg_w Anything a
325	a:index reset AnythingNode true
326
327
328	method da type d -> t
329	oarg DataAnything da ; arg Data_ d ; arg_R Type t
330	t :> Str
331
332	method da get d adr type -> status
333	oarg DataAnything da ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status
334	status := from_string adr type (d:adr map Anything):value "db"
335
336	method da set d adr type -> status
337	oarg_rw DataAnything da ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status
338	(d:adr map Anything) value := to_string adr type "db"
339	d:base notify_set d d:adr Str
340	status := success
341
342	method da reset d -> status
343	oarg_rw DataAnything da ; arg_rw Data_ d ; arg Status status
344	(d:adr map Anything) value := ""
345	var Pointer:Index_ idx :> (d:adr map Anything) index
346	idx reset AnythingNode true
347	d:base notify_reset d
348	status := success
349
350
351	method da search d k -> d2
352	oarg DataAnything da ; arg Data_ d ; arg Str k ; arg Data_ d2
353	var Pointer:Index_ idx :> (d:adr map Anything) index
354	var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
355	if cursor<>null
356	d2 adr := cursor
357	d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
358	d2 interface :> da
359	else
360	d2 := data_null
361	d2 base :> d base
362	d2 path1 :> new Str d:dbpath+"/"+html_encode:k
363	d2 path2 :> null map Str
364
365	method da first d start stop buf -> d2
366	oarg DataAnything da ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2
367	var Pointer:Index_ idx :> (d:adr map Anything) index
368	var Address cursor
369	if start:len=0
370	cursor := idx first IndexNode_:size+Str:size
371	else
372	cursor := idx from addressof:start (the_function compare Str Str -> Int) IndexNode_:size+Str:size
373	d2 adr := cursor
374	if cursor<>null
375	d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
376	d2 interface :> da
377	d2 base :> d base
378	var Pointer:Str k :> (cursor translate Str -1) map Str
379	d2 path1 :> new Str d:dbpath+"/"+html_encode:k
380	d2 path2 :> null map Str
381	buf adr := cursor
382
383	method da next d start stop buf -> d2
384	oarg DataAnything da ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2
385	var Pointer:Index_ idx :> (d:adr map Anything) index
386	if (idx is_deleted buf:adr IndexNode_:size+Str:size)
387	var Str key := (buf:adr translate Str -1) map Str
388	# console "automatic recovery of deleted key " key eol
389	d2 := da first d key stop buf
390	if d2:adr<>null and d2:key=key
391	d2 := da next d start stop buf
392	return
393	var Address cursor := idx next buf:adr IndexNode_:size+Str:size
394	if cursor=null
395	d2 adr := null
396	return
397	var Pointer:Str k :> (cursor translate Str -1) map Str
398	if stop:len>0 and k>=stop
399	d2 adr := null
400	return
401	d2 adr := cursor
402	d2 object := cursor translate Byte -(Str:size+IndexNode_:size)
403	d2 interface :> da
404	d2 base :> d base
405	var Pointer:Str k :> (cursor translate Str -1) map Str
406	d2 path1 :> new Str d:dbpath+"/"+html_encode:k
407	d2 path2 :> null map Str
408	buf adr := cursor
409
410	method da count d start stop -> count
411	oarg_rw DataAnything da ; arg Data_ d ; arg Str start stop ; arg Int count
412	var Pointer:Index_ idx :> (d:adr map Anything) index
413	if start:len=0 and stop:len=0
414	count := idx size
415	else
416	# highly suboptimal implementation
417	count := 0
418	var Data_ cur := da first d start stop (var DataScanBuffer buf)
419	while cur:adr<>null
420	var Data_ cur := da next d start stop buf
421	count += 1
422
423
424	method da create d k -> status
425	oarg_rw DataAnything da ; arg_rw Data_ d ; arg Str k; arg Status status
426	var Pointer:Index_ idx :> (d:adr map Anything) index
427	var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
428	if cursor=null
429	idx insert addressof:k false null (the_function compare Str Str -> Int) Str:size+IndexNode_:size Str Anything AnythingNode true
430	d:base notify_create d k
431	status := success
432	else
433	status := failure
434
435	method da delete d k -> status
436	oarg_rw DataAnything da ; arg_rw Data_ d ; arg Str k; arg Status status
437	var Pointer:Index_ idx :> (d:adr map Anything) index
438	var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size
439	if cursor<>null
440	idx remove cursor IndexNode_:size+Str:size AnythingNode true
441	d:base notify_delete d k
442	status := success
443	else
444	status := failure
445
446
447
448
449	doc
450	[The 'interface' function will return an object that implements 'DataInterface_' generic methods, and that will be used to map an object with the type provided as the argument.]
451
452
453	function inmemory_interface t -> di
454	arg Type t ; arg Link:DataInterface_ di
455	var DataKind k := data_kind t
456	if t=Anything
457	di :> new DataAnything
458	eif k=data_field
459	var Link:DataField df :> new DataField
460	df type :> t
461	di :> df
462	eif k=data_record
463	var Link:DataRecord dr :> new DataRecord
464	dr type :> t
465	var (Index Str Arrow) order
466	for (var Int i) 0 t:nb_fields-1
467	var Link:DataRecordFieldDef f :> new DataRecordFieldDef
468	f record_interface :> dr
469	f offset := (t field i) offset
470	f interface :> data_interface (t field i):type
471	f path := "/"+(html_encode (t field i):name)
472	f default := (t field i) initial_value
473	dr:fields insert (t field i):name false addressof:f
474	var Arrow a := addressof f
475	order insert (t field i):name a
476	var Pointer:Arrow c :> order first
477	while addressof:c<>null
478	dr:all_fields append c
479	c :> order next c
480	di :> dr
481	eif k=data_set
482	var Pointer:Type v :> t value_type
483	var Link:DataTable dt :> new DataTable
484	dt value_interface :> data_interface v
485	dt value_type :> v
486	dt node_type :> ('pliant data setnode types' query addressof:v null) map Type
487	di :> dt
488
489	data_interface_generators append addressof:(the_function inmemory_interface Type -> Link:DataInterface_)