X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaDb.ml;h=b5b64d46f1d958c7d9c02a48a099253bb3137176;hb=33a02e0b639217093eb63f30169aaa6ac8c78907;hp=878bd4fe7656dbeba5326b572967d666643a86c5;hpb=11d81280208345b189c174e2ae19a6ab45e2b03a;p=helm.git diff --git a/helm/matita/matitaDb.ml b/helm/matita/matitaDb.ml index 878bd4fe7..b5b64d46f 100644 --- a/helm/matita/matitaDb.ml +++ b/helm/matita/matitaDb.ml @@ -37,6 +37,7 @@ let instance = let xpointer_RE = Pcre.regexp "#.*$" +let file_scheme_RE = Pcre.regexp "^file://" let clean_owner_environment () = let dbd = instance () in @@ -65,7 +66,10 @@ let clean_owner_environment () = (fun uri -> let uri = Pcre.replace ~rex:xpointer_RE ~templ:"" uri in List.iter - (fun suffix -> Http_getter.unregister (uri ^ suffix)) + (fun suffix -> + try + MatitaMisc.safe_remove (Http_getter.resolve (uri ^ suffix)) + with Http_getter_types.Key_not_found _ -> ()) [""; ".body"; ".types"]) owned_uris; List.iter (fun statement -> @@ -101,6 +105,7 @@ let create_owner_environment () = let status = Mysql.status dbd in match status with | Mysql.StatusError Mysql.Table_exists_error -> () + | Mysql.StatusError Mysql.Dup_keyname -> () | Mysql.StatusError _ -> raise exn | _ -> () ) statements @@ -109,7 +114,7 @@ let create_owner_environment () = (* removes uri from the ownerized tables, and returns the list of other objects * (theyr uris) that ref the one removed. * AFAIK there is no need to return it, since the MatitaTypes.staus should - * contain all defined objects. but to double ckeck we do not garbage the + * contain all defined objects. but to double check we do not garbage the * metadata... *) let remove_uri uri = @@ -135,20 +140,27 @@ let remove_uri uri = [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 suri + sprintf "SELECT source FROM %s WHERE h_occurrence LIKE '%s%%'" obj_tbl + (Mysql.escape suri) in try let rc = Mysql.exec dbd dbg_q in let l = ref [] in Mysql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l); let l = List.sort Pervasives.compare !l in - let rec uniq = function - | [] -> [] - | h::[] -> [h] - | h1::h2::tl when h1 = h2 -> uniq (h2 :: tl) - | h1::tl (* when h1 <> h2 *) -> h1 :: uniq tl - in - uniq l + MatitaMisc.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 + (Mysql.escape (UriManager.string_of_uri uri)) + in + let rc = Mysql.exec dbd query in + let l = ref [] in + Mysql.iter rc (fun a -> match a.(0) with None ->()|Some a -> l := a:: !l); + List.map UriManager.uri_of_string !l +