(* $Id$ *)
-open Printf ;;
+let dbtype_of_string dbtype =
+ if dbtype = "library" then HSql.Library
+ else if dbtype = "user" then HSql.User
+ else if dbtype = "legacy" then HSql.Legacy
+ else raise (HSql.Error "HSql: wrong config file format")
+
+let parse_dbd_conf _ =
+ let metadata = Helm_registry.get_list Helm_registry.string "db.metadata" in
+ List.map
+ (fun s ->
+ match Pcre.split ~pat:"\\s+" s with
+ | [path;db;user;pwd;dbtype] ->
+ let dbtype = dbtype_of_string dbtype in
+ let pwd = if pwd = "none" then None else Some pwd in
+ (* TODO parse port *)
+ path, None, db, user, pwd, dbtype
+ | _ -> raise (HSql.Error "HSql: Bad format in config file"))
+ metadata
+;;
+
+let parse_dbd_conf _ =
+ HSql.mk_dbspec (parse_dbd_conf ())
+;;
let instance =
let dbd = lazy (
- HSql.quick_connect
- ~host:(Helm_registry.get "db.host")
- ~user:(Helm_registry.get "db.user")
- ~database:(Helm_registry.get "db.database")
- ())
+ let dbconf = parse_dbd_conf () in
+ HSql.quick_connect dbconf)
in
fun () -> Lazy.force dbd
-
+;;
let xpointer_RE = Pcre.regexp "#.*$"
let file_scheme_RE = Pcre.regexp "^file://"
(obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
(name_tbl,`ObjectName) ; (count_tbl,`Count) ]
in
+ let dbtype =
+ if Helm_registry.get_bool "matita.system" then HSql.Library else HSql.User
+ in
let statements =
- (SqlStatements.drop_tables tbls) @ (SqlStatements.drop_indexes tbls)
+ (SqlStatements.drop_tables tbls) @
+ (SqlStatements.drop_indexes tbls dbtype dbd)
in
let owned_uris =
try
MetadataDb.clean ~dbd
with (HSql.Error _) as exn ->
- match HSql.errno dbd with
+ match HSql.errno dbtype dbd with
| HSql.No_such_table -> []
| _ -> raise exn
in
(fun suffix ->
try
HExtlib.safe_remove
- (Http_getter.resolve ~writable:true (uri ^ suffix))
+ (Http_getter.resolve ~local:true ~writable:true (uri ^ suffix))
with Http_getter_types.Key_not_found _ -> ())
[""; ".body"; ".types"])
owned_uris;
List.iter (fun statement ->
try
- ignore (HSql.exec dbd statement)
+ ignore (HSql.exec dbtype dbd statement)
with (HSql.Error _) as exn ->
- match HSql.errno dbd with
+ match HSql.errno dbtype dbd with
| HSql.No_such_table
| HSql.Bad_table_error
- | HSql.No_such_index -> prerr_endline statement; ()
+ | HSql.No_such_index -> ()
| _ -> raise exn
) statements;
;;
(l_obj_tbl,`RefObj) ; (l_sort_tbl,`RefSort) ; (l_rel_tbl,`RefRel) ;
(l_name_tbl,`ObjectName) ; (l_count_tbl,`Count) ]
in
+ let tag tag l = List.map (fun x -> tag, x) l in
let statements =
- (SqlStatements.create_tables system_tbls) @
- (SqlStatements.create_tables tbls) @
- (SqlStatements.create_indexes system_tbls) @
- (SqlStatements.create_indexes tbls)
+ (tag HSql.Library (SqlStatements.create_tables system_tbls)) @
+ (tag HSql.User (SqlStatements.create_tables tbls)) @
+ (tag HSql.Library (SqlStatements.create_indexes system_tbls)) @
+ (tag HSql.User (SqlStatements.create_indexes tbls))
in
- List.iter (fun statement ->
- try
- ignore (HSql.exec dbd statement)
- with
- (HSql.Error _) as exc ->
- let status = HSql.errno dbd in
- match status with
- | HSql.Table_exists_error -> ()
- | HSql.Dup_keyname -> ()
- | HSql.GENERIC_ERROR _ ->
- prerr_endline statement;
- raise exc
- | _ -> ()
-
-
- ) statements
+ List.iter
+ (fun (dbtype, statement) ->
+ try
+ ignore (HSql.exec dbtype dbd statement)
+ with
+ (HSql.Error _) as exc ->
+ let status = HSql.errno dbtype dbd in
+ match status with
+ | HSql.Table_exists_error -> ()
+ | HSql.Dup_keyname -> ()
+ | HSql.GENERIC_ERROR _ ->
+ prerr_endline statement;
+ raise exc
+ | _ -> ())
+ statements
;;
(* removes uri from the ownerized tables, and returns the list of other objects
let dbd = instance () in
let suri = UriManager.string_of_uri uri in
+ let dbtype =
+ if Helm_registry.get_bool "matita.system" then HSql.Library else HSql.User
+ in
let query table suri =
- if HSql.isMysql then
- sprintf "DELETE QUICK LOW_PRIORITY FROM %s WHERE source='%s'" table (HSql.escape suri)
- else sprintf "DELETE FROM %s WHERE source='%s'" table (HSql.escape suri)
+ if HSql.isMysql dbtype dbd then
+ Printf.sprintf "DELETE QUICK LOW_PRIORITY FROM %s WHERE source='%s'" table
+ (HSql.escape dbtype dbd suri)
+ else
+ Printf.sprintf "DELETE FROM %s WHERE source='%s'" table
+ (HSql.escape dbtype dbd suri)
in
List.iter (fun t ->
try
- ignore (HSql.exec dbd (query t suri))
+ ignore (HSql.exec dbtype dbd (query t suri))
with
exn -> raise exn (* no errors should be accepted *)
)
let xpointers_of_ind uri =
let dbd = instance () in
let name_tbl = MetadataTypes.name_tbl () in
+ let dbtype =
+ if Helm_registry.get_bool "matita.system" then HSql.Library else HSql.User
+ in
let escape s =
- Pcre.replace ~pat:"([^\\\\])_" ~templ:"$1\\_" (HSql.escape s)
+ Pcre.replace ~pat:"([^\\\\])_" ~templ:"$1\\_"
+ (HSql.escape dbtype dbd s)
in
- let query = sprintf
- "SELECT source FROM %s WHERE source LIKE '%s#xpointer%%' ESCAPE \"\\\" "
+ let query = Printf.sprintf
+ ("SELECT source FROM %s WHERE source LIKE '%s#xpointer%%' "
+ ^^ HSql.escape_string_for_like dbtype dbd)
name_tbl (escape (UriManager.string_of_uri uri))
in
- let rc = HSql.exec dbd query in
+ let rc = HSql.exec dbtype dbd query in
let l = ref [] in
HSql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l);
List.map UriManager.uri_of_string !l