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/
28 let dbtype_of_string dbtype =
29 if dbtype = "library" then HSql.Library
30 else if dbtype = "user" then HSql.User
31 else if dbtype = "legacy" then HSql.Legacy
32 else raise (HSql.Error "HSql: wrong config file format")
34 let parse_dbd_conf _ =
35 let metadata = Helm_registry.get_list Helm_registry.string "db.metadata" in
38 match Pcre.split ~pat:"\\s+" s with
39 | [path;db;user;pwd;dbtype] ->
40 let dbtype = dbtype_of_string dbtype in
41 let pwd = if pwd = "none" then None else Some pwd in
43 path, None, db, user, pwd, dbtype
44 | _ -> raise (HSql.Error "HSql: Bad format in config file"))
48 let parse_dbd_conf _ =
49 HSql.mk_dbspec (parse_dbd_conf ())
54 let dbconf = parse_dbd_conf () in
55 HSql.quick_connect dbconf)
57 fun () -> Lazy.force dbd
60 let xpointer_RE = Pcre.regexp "#.*$"
61 let file_scheme_RE = Pcre.regexp "^file://"
63 let clean_owner_environment () = assert false (* MATITA 1.0
64 let dbd = instance () in
65 let obj_tbl = MetadataTypes.obj_tbl () in
66 let sort_tbl = MetadataTypes.sort_tbl () in
67 let rel_tbl = MetadataTypes.rel_tbl () in
68 let name_tbl = MetadataTypes.name_tbl () in
69 let count_tbl = MetadataTypes.count_tbl () in
71 (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
72 (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
75 if Helm_registry.get_bool "matita.system" then HSql.Library else HSql.User
78 (SqlStatements.drop_tables tbls) @
79 (SqlStatements.drop_indexes tbls dbtype dbd)
84 with (HSql.Error _) as exn ->
85 match HSql.errno dbtype dbd with
86 | HSql.No_such_table -> []
91 let uri = Pcre.replace ~rex:xpointer_RE ~templ:"" uri in
96 (Http_getter.resolve ~local:true ~writable:true (uri ^ suffix))
97 with Http_getter_types.Key_not_found _ -> ())
98 [""; ".body"; ".types"])
100 List.iter (fun statement ->
102 ignore (HSql.exec dbtype dbd statement)
103 with (HSql.Error _) as exn ->
104 match HSql.errno dbtype dbd with
106 | HSql.Bad_table_error
107 | HSql.No_such_index -> ()
113 let create_owner_environment () = () (* MATITA 1.0
114 let dbd = instance () in
115 let obj_tbl = MetadataTypes.obj_tbl () in
116 let sort_tbl = MetadataTypes.sort_tbl () in
117 let rel_tbl = MetadataTypes.rel_tbl () in
118 let name_tbl = MetadataTypes.name_tbl () in
119 let count_tbl = MetadataTypes.count_tbl () in
120 let l_obj_tbl = MetadataTypes.library_obj_tbl in
121 let l_sort_tbl = MetadataTypes.library_sort_tbl in
122 let l_rel_tbl = MetadataTypes.library_rel_tbl in
123 let l_name_tbl = MetadataTypes.library_name_tbl in
124 let l_count_tbl = MetadataTypes.library_count_tbl in
126 (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
127 (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
130 (l_obj_tbl,`RefObj) ; (l_sort_tbl,`RefSort) ; (l_rel_tbl,`RefRel) ;
131 (l_name_tbl,`ObjectName) ; (l_count_tbl,`Count) ]
133 let tag tag l = List.map (fun x -> tag, x) l in
135 (tag HSql.Library (SqlStatements.create_tables system_tbls)) @
136 (tag HSql.User (SqlStatements.create_tables tbls)) @
137 (tag HSql.Library (SqlStatements.create_indexes system_tbls)) @
138 (tag HSql.User (SqlStatements.create_indexes tbls))
141 (fun (dbtype, statement) ->
143 ignore (HSql.exec dbtype dbd statement)
145 (HSql.Error _) as exc ->
146 let status = HSql.errno dbtype dbd in
148 | HSql.Table_exists_error -> ()
149 | HSql.Dup_keyname -> ()
150 | HSql.GENERIC_ERROR _ ->
151 prerr_endline statement;
158 (* removes uri from the ownerized tables, and returns the list of other objects
159 * (theyr uris) that ref the one removed.
160 * AFAIK there is no need to return it, since the MatitaTypes.staus should
161 * contain all defined objects. but to double check we do not garbage the
164 let remove_uri uri = assert false (* MATITA 1.0
165 let obj_tbl = MetadataTypes.obj_tbl () in
166 let sort_tbl = MetadataTypes.sort_tbl () in
167 let rel_tbl = MetadataTypes.rel_tbl () in
168 let name_tbl = MetadataTypes.name_tbl () in
169 (*let conclno_tbl = MetadataTypes.conclno_tbl () in
170 let conclno_hyp_tbl = MetadataTypes.fullno_tbl () in*)
171 let count_tbl = MetadataTypes.count_tbl () in
173 let dbd = instance () in
174 let suri = UriManager.string_of_uri uri in
176 if Helm_registry.get_bool "matita.system" then HSql.Library else HSql.User
178 let query table suri =
179 if HSql.isMysql dbtype dbd then
180 Printf.sprintf "DELETE QUICK LOW_PRIORITY FROM %s WHERE source='%s'" table
181 (HSql.escape dbtype dbd suri)
183 Printf.sprintf "DELETE FROM %s WHERE source='%s'" table
184 (HSql.escape dbtype dbd suri)
188 ignore (HSql.exec dbtype dbd (query t suri))
190 exn -> raise exn (* no errors should be accepted *)
192 [obj_tbl;sort_tbl;rel_tbl;name_tbl;(*conclno_tbl;conclno_hyp_tbl*)count_tbl];
196 let xpointers_of_ind uri = assert false (* MATITA 1.0
197 let dbd = instance () in
198 let name_tbl = MetadataTypes.name_tbl () in
200 if Helm_registry.get_bool "matita.system" then HSql.Library else HSql.User
203 Pcre.replace ~pat:"([^\\\\])_" ~templ:"$1\\_"
204 (HSql.escape dbtype dbd s)
206 let query = Printf.sprintf
207 ("SELECT source FROM %s WHERE source LIKE '%s#xpointer%%' "
208 ^^ HSql.escape_string_for_like dbtype dbd)
209 name_tbl (escape (UriManager.string_of_uri uri))
211 let rc = HSql.exec dbtype dbd query in
213 HSql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l);
214 List.map UriManager.uri_of_string !l