1 (* Copyright (C) 2004-2005, HELM Team.
3 * This file is part of HELM, an Hypertextual, Electronic
4 * Library of Mathematics, developed at the Computer Science
5 * Department, University of Bologna, Italy.
7 * HELM is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
12 * HELM is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with HELM; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 * For details, see the HELM World-Wide-Web page,
23 * http://helm.cs.unibo.it/
31 ~host:(Helm_registry.get "db.host")
32 ~user:(Helm_registry.get "db.user")
33 ~database:(Helm_registry.get "db.database")
36 fun () -> Lazy.force dbd
39 let xpointer_RE = Pcre.regexp "#.*$"
41 let clean_owner_environment () =
42 let dbd = instance () in
43 let owner = (Helm_registry.get "matita.owner") in
44 let obj_tbl = MetadataTypes.obj_tbl () in
45 let sort_tbl = MetadataTypes.sort_tbl () in
46 let rel_tbl = MetadataTypes.rel_tbl () in
47 let name_tbl = MetadataTypes.name_tbl () in
48 let conclno_tbl = MetadataTypes.conclno_tbl () in
49 let conclno_hyp_tbl = MetadataTypes.fullno_tbl () in
51 sprintf "DROP TABLE %s ;" obj_tbl;
52 sprintf "DROP TABLE %s ;" sort_tbl;
53 sprintf "DROP TABLE %s ;" rel_tbl;
54 sprintf "DROP TABLE %s ;" name_tbl;
55 sprintf "DROP TABLE %s ;" conclno_tbl;
56 sprintf "DROP TABLE %s ;" conclno_hyp_tbl ] in
58 DROP INDEX refObj_source ON refObj (source);
59 DROP INDEX refObj_target ON refObj (h_occurrence);
60 DROP INDEX refObj_position ON refObj (h_position);
61 DROP INDEX refSort_source ON refSort (source);
62 DROP INDEX objectName_value ON objectName (value);
63 DROP INDEX no_inconcl_aux_source ON no_inconcl_aux (source);
64 DROP INDEX no_inconcl_aux_no ON no_inconcl_aux (no);
65 DROP INDEX no_concl_hyp_source ON no_concl_hyp (source);
66 DROP INDEX no_concl_hyp_no ON no_concl_hyp (no);
71 with Mysql.Error _ as exn ->
72 match Mysql.errno dbd with
73 | Mysql.No_such_table -> []
78 let uri = Pcre.replace ~rex:xpointer_RE ~templ:"" uri in
80 (fun suffix -> Http_getter.unregister (uri ^ suffix))
81 [""; ".body"; ".types"])
83 List.iter (fun statement ->
85 ignore (Mysql.exec dbd statement)
86 with Mysql.Error _ as exn ->
87 match Mysql.errno dbd with
88 | Mysql.Bad_table_error -> ()
93 let create_owner_environment () =
94 let dbd = instance () in
95 let owner = (Helm_registry.get "matita.owner") in
96 let obj_tbl = MetadataTypes.obj_tbl () in
97 let sort_tbl = MetadataTypes.sort_tbl () in
98 let rel_tbl = MetadataTypes.rel_tbl () in
99 let name_tbl = MetadataTypes.name_tbl () in
100 let conclno_tbl = MetadataTypes.conclno_tbl () in
101 let conclno_hyp_tbl = MetadataTypes.fullno_tbl () in
103 sprintf "CREATE TABLE %s (
104 source varchar(255) binary not null,
105 h_occurrence varchar(255) binary not null,
106 h_position varchar(255) binary not null,
109 sprintf "CREATE TABLE %s (
110 source varchar(255) binary not null,
111 h_position varchar(255) binary not null,
112 h_depth integer not null,
113 h_sort varchar(255) binary not null
115 sprintf "CREATE TABLE %s (
116 source varchar(255) binary not null,
117 h_position varchar(255) binary not null,
118 h_depth integer not null
120 sprintf "CREATE TABLE %s (
121 source varchar(255) binary not null,
122 value varchar(255) binary not null
124 sprintf "CREATE TABLE %s (
125 source varchar(255) binary not null,
126 no tinyint(4) not null
128 sprintf "CREATE TABLE %s (
129 source varchar(255) binary not null,
130 no tinyint(4) not null
131 );" conclno_hyp_tbl ] in
133 CREATE INDEX refObj_source ON refObj (source);
134 CREATE INDEX refObj_target ON refObj (h_occurrence);
135 CREATE INDEX refObj_position ON refObj (h_position);
136 CREATE INDEX refSort_source ON refSort (source);
137 CREATE INDEX objectName_value ON objectName (value);
138 CREATE INDEX no_inconcl_aux_source ON no_inconcl_aux (source);
139 CREATE INDEX no_inconcl_aux_no ON no_inconcl_aux (no);
140 CREATE INDEX no_concl_hyp_source ON no_concl_hyp (source);
141 CREATE INDEX no_concl_hyp_no ON no_concl_hyp (no);
143 List.iter (fun statement ->
145 ignore (Mysql.exec dbd statement)
148 let status = Mysql.status dbd in
150 | Mysql.StatusError Mysql.Table_exists_error -> ()
151 | Mysql.StatusError _ -> raise exn
156 (* removes uri from the ownerized tables, and returns the list of other objects
157 * (theyr uris) that ref the one removed.
158 * AFAIK there is no need to return it, since the MatitaTypes.staus should
159 * contain all defined objects. but to double ckeck we do not garbage the
163 let obj_tbl = MetadataTypes.obj_tbl () in
164 let sort_tbl = MetadataTypes.sort_tbl () in
165 let rel_tbl = MetadataTypes.rel_tbl () in
166 let name_tbl = MetadataTypes.name_tbl () in
167 let conclno_tbl = MetadataTypes.conclno_tbl () in
168 let conclno_hyp_tbl = MetadataTypes.fullno_tbl () in
169 let dbd = instance () in
170 let suri = UriManager.string_of_uri uri in
171 let query table suri = sprintf
172 "DELETE FROM %s WHERE source LIKE '%s%%'" table (Mysql.escape suri)
176 ignore (Mysql.exec dbd (query t suri))
178 exn -> raise exn (* no errors should be accepted *)
179 ) [obj_tbl;sort_tbl;rel_tbl;name_tbl;conclno_tbl;conclno_hyp_tbl];
180 (* and now the debug job *)
182 sprintf "SELECT source FROM %s WHERE h_occurrence LIKE '%s%%'" obj_tbl suri
185 let rc = Mysql.exec dbd dbg_q in
187 Mysql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l);
188 let l = List.sort Pervasives.compare !l in
189 let rec uniq = function
192 | h1::h2::tl when h1 = h2 -> uniq (h2 :: tl)
193 | h1::tl (* when h1 <> h2 *) -> h1 :: uniq tl
197 exn -> raise exn (* no errors should be accepted *)