/pliant/appli/data_browser.pli
1	abstract
2	[This virtual tree page maps all the database data in the server as a tree in the HTTP server.]
3	doc
4	[Don't use this as a sample on how to use Pliant database engine: ]
5	[This page is using the low level interface whereas most of your applications will use the high level one.]
6
7	module "/pliant/protocol/http/server.pli"
8	module "/pliant/protocol/http/style/default.style"
9	module "/pliant/util/encoding/html.pli"
10	module "/pliant/language/compiler.pli"
11	module "/pliant/language/stream.pli"
12	module "/pliant/storage/database.pli"
13	module "/pliant/storage/database/io.pli"
14
15	module "/pliant/fullpliant/user.pli"
16	module "/pliant/fullpliant/computer.pli"
17	module "/pliant/protocol/http/site.pli"
18
19
20	method page data_browser path options write
21	arg_rw HtmlPage page ; arg Str path options ; arg CBool write
22	implicit page
23
24	var Data_ master := data_root search_path path false
25	if master:adr=null
26
27	http_request:answer_status := "404 There is no such data on this system"
28	[There is no data ] ; fixed (text path) ; eol
29
30	eif options="table"
31
32	var List:Str cols ; var Int count := 0
33	master:base:sem rd_request
34	var Data_ line := master:interface first master "" "" (var DataScanBuffer buf)
35	line:base:sem rd_request
36	var Data_ col := line:interface first line "" "" (var DataScanBuffer buf2)
37	while col:adr<>null
38	col := line:interface next line "" "" buf2
39	cols += col key ; count += 1
40	line:base:sem rd_release
41	table columns count+1
42	cell void
43	var Pointer:Str ptr :> cols first
44	while exists:ptr
45	cell header text:ptr
46	ptr :> cols next ptr
47	while line:adr<>null
48	line:base:sem rd_request
49	cell
50	link line:key http_request:path+"/"+(html_encode line:key) options "table" no_extension
51	var Pointer:Str ptr :> cols first
52	while exists:ptr
53	cell
54	var Data_ col := line:interface search line ptr
55	var Link:Type t :> col:interface type col
56	if t<>Void and (col:interface get col addressof:(var Str value) Str)=success
57	text value
58	ptr :> cols next ptr
59	line:base:sem rd_release
60	line := master:interface next master "" "" buf
61	master:base:sem rd_release
62
63	else
64
65	title "Data browser"
66	table columns 2 border 0
67	cell [Path:]
68	cell (fixed text:path)
69	master:base:sem rd_request
70	var Link:Type t :> master:interface type master
71	if t<>Void
72	cell [Type:]
73	cell fixed:(text t:name)
74	if t<>Void and (master:interface get master addressof:(var Str value) Str)=success
75	cell [Value:]
76	var Data:Str test :> path pmap Str
77	if write
78	cell
79	input "" test length 60 noeol
80	button "Change it"
81	goto_backward
82	else
83	cell fixed:(text value)
84	master:base:sem rd_release
85
86	if options<>"all" or not allowed:"administrator"
87
88	master:base:sem rd_request
89	var Data_ sub := master:interface first master "" "" (var DataScanBuffer buf)
90	if sub:adr<>null
91	table columns 4
92	cell header
93	bold [Key]
94	cell header
95	bold [Type]
96	cell header
97	bold [Value]
98	cell void
99	while sub:adr<>null
100	cell
101	link sub:key http_request:path+"/"+(html_encode sub:key) no_extension
102	if (addressof sub:base)<>(addressof master:base)
103	sub:base:sem rd_request
104	var Link:Type t :> sub:interface type sub
105	if t<>Void and (sub:interface get sub addressof:(var Str value) Str)=success
106	cell fixed:(text t:name)
107	else
108	cell void
109	if t<>Void and (sub:interface get sub addressof:(var Str value) Str)=success
110	cell fixed:(text value)
111	else
112	cell void
113	cell
114	var Data_ more := sub:interface first sub "" "" (var DataScanBuffer buf2)
115	if more:adr<>null
116	[...]
117	if (addressof sub:base)<>(addressof master:base)
118	sub:base:sem rd_release
119	sub := master:interface next master "" "" buf
120	master:base:sem rd_release
121
122	if allowed:"administrator"
123	small
124	link "expand all" http_request:path no_extension options "all" ; eol
125
126	if (addressof master:base)<>(addressof data_root:base)
127	if allowed:"administrator"
128	var Str mime := "text/plain"
129	select "" (var Str mime) noeol
130	option "view" "text/plain"
131	option "store" "binary/*"
132	button "download"
133	var Data_ master2 := data_root search_path path false
134	var Link:Database_ base :> master2 base
135	if master2:adr<>null
136	reset_http_answer
137	http_request send_header "mime "+string:mime
138	base:sem rd_request
139	master2 store http_request:answer_stream
140	base:sem rd_release
141	http_request send_footer
142	else
143	[Internal bug in Pliant module /pliant/appli/data_browser.pli]
144	if write
145	input "" (var Str key) noeol
146	button "create key" noeol
147	(path pmap Set:Str) create key
148	reload_page
149	button "delete key"
150	(path pmap Set:Str) delete key
151	reload_page
152	if allowed:"administrator"
153	file_upload "" (var Str filename) noeol
154	select "" (var Str action) noeol
155	option "add and replace only" ""
156	option "clear then add" "clear"
157	button "upload"
158	var Data_ master2 := data_root search_path path false
159	var Link:Database_ base :> master2 base
160	if master2:adr<>null
161	base:sem request
162	if action="clear"
163	master2:interface reset master2
164	(var Stream s) open filename in+safe
165	base get_root (var Data_ root)
166	root load s
167	base:sem release
168	reload_page
169	else
170	[Internal bug in Pliant module /pliant/appli/data_browser.pli]
171
172	else
173
174	function display_data_tree data header page
175	arg_rw Data_ data ; arg Str header ; arg_rw HtmlPage page
176	cell
177	fixed
178	text header+data:key
179	data:base:sem rd_request
180	var Link:Type t :> data:interface type data
181	if t<>Void
182	cell
183	small
184	italic
185	text t:name
186	else
187	cell void
188	if t<>Void and (data:interface get data addressof:(var Str value) Str)=success
189	cell
190	fixed
191	text value
192	else
193	cell void
194	var Data_ more := data:interface first data "" "" (var DataScanBuffer buf)
195	while more:adr<>null
196	data:base:sem rd_release
197	display_data_tree more header+". " page
198	data:base:sem rd_request
199	more := data:interface next data "" "" buf
200	data:base:sem rd_release
201
202	table columns 3 border 0 padding 0
203	cell header
204	bold [Subpath]
205	cell header
206	bold [Type]
207	cell header
208	bold [Value]
209	master:base:sem rd_request
210	var Data_ sub := master:interface first master "" "" (var DataScanBuffer buf)
211	while sub:adr<>null
212	master:base:sem rd_release
213	display_data_tree sub "" page
214	master:base:sem rd_request
215	sub := master:interface next master "" "" buf
216	master:base:sem rd_release
217
218
219	export '. data_browser'
220
221