X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Flibrary%2FlibraryDb.ml;h=78cff79482d2f261c5c46c461d65f2a0152f0a69;hb=3638e4f4fbdc00124e97006d47ce2ada952da031;hp=858e4c4ff790e97dee62f215862bf5e55db939a0;hpb=5cb95a2e44f979183a8c3e39baa3b4e7cfaf8182;p=helm.git diff --git a/components/library/libraryDb.ml b/components/library/libraryDb.ml index 858e4c4ff..78cff7948 100644 --- a/components/library/libraryDb.ml +++ b/components/library/libraryDb.ml @@ -29,7 +29,7 @@ open Printf ;; let instance = let dbd = lazy ( - HMysql.quick_connect + HSql.quick_connect ~host:(Helm_registry.get "db.host") ~user:(Helm_registry.get "db.user") ~database:(Helm_registry.get "db.database") @@ -58,9 +58,9 @@ let clean_owner_environment () = let owned_uris = try MetadataDb.clean ~dbd - with Mysql.Error _ as exn -> - match HMysql.errno dbd with - | Mysql.No_such_table -> [] + with HSql.Error as exn -> + match HSql.errno dbd with + | HSql.No_such_table -> [] | _ -> raise exn in List.iter @@ -76,11 +76,12 @@ let clean_owner_environment () = owned_uris; List.iter (fun statement -> try - ignore (HMysql.exec dbd statement) - with Mysql.Error _ as exn -> - match HMysql.errno dbd with - | Mysql.Bad_table_error - | Mysql.No_such_index | Mysql.No_such_table -> () + ignore (HSql.exec dbd statement) + with HSql.Error as exn -> + match HSql.errno dbd with + | HSql.No_such_table + | HSql.Bad_table_error + | HSql.No_such_index -> prerr_endline statement; () | _ -> raise exn ) statements; ;; @@ -113,15 +114,19 @@ let create_owner_environment () = in List.iter (fun statement -> try - ignore (HMysql.exec dbd statement) + ignore (HSql.exec dbd statement) with - exn -> - let status = HMysql.status dbd in - match status with - | Mysql.StatusError Mysql.Table_exists_error -> () - | Mysql.StatusError Mysql.Dup_keyname -> () - | Mysql.StatusError _ -> raise exn - | _ -> () + HSql.Error -> + let status = HSql.errno dbd in + match status with + | HSql.Table_exists_error -> () + | HSql.Dup_keyname -> () + | HSql.GENERIC_ERROR _ -> + prerr_endline statement; + raise HSql.Error + | _ -> () + + ) statements ;; @@ -142,39 +147,29 @@ let remove_uri uri = let dbd = instance () in let suri = UriManager.string_of_uri uri in - let query table suri = sprintf - "DELETE FROM %s WHERE source LIKE '%s%%'" table (HMysql.escape suri) + 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) in List.iter (fun t -> try - ignore (HMysql.exec dbd (query t suri)) + ignore (HSql.exec dbd (query t suri)) with exn -> raise exn (* no errors should be accepted *) ) [obj_tbl;sort_tbl;rel_tbl;name_tbl;(*conclno_tbl;conclno_hyp_tbl*)count_tbl]; - (* and now the debug job *) - let dbg_q = - sprintf "SELECT source FROM %s WHERE h_occurrence LIKE '%s%%'" obj_tbl - (HMysql.escape suri) - in - try - let rc = HMysql.exec dbd dbg_q in - let l = ref [] in - HMysql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l); - let l = List.sort Pervasives.compare !l in - HExtlib.list_uniq l - 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 query = sprintf "SELECT source FROM %s WHERE source LIKE '%s#xpointer%%'" name_tbl - (HMysql.escape (UriManager.string_of_uri uri)) + (HSql.escape (UriManager.string_of_uri uri)) in - let rc = HMysql.exec dbd query in + let rc = HSql.exec dbd query in let l = ref [] in - HMysql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l); + HSql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l); List.map UriManager.uri_of_string !l