(* Copyright (C) 2004, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science * Department, University of Bologna, Italy. * * HELM is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * HELM is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with HELM; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, * MA 02111-1307, USA. * * For details, see the HELM World-Wide-Web page, * http://helm.cs.unibo.it/ *) open MetadataTypes open Printf let execute_insert dbd uri (sort_cols, rel_cols, obj_cols) = let sort_tuples = List.fold_left (fun s l -> match l with | [`String a; `String b; `Int c; `String d] -> sprintf "(\"%s\", \"%s\", %d, \"%s\")" a b c d :: s | _ -> assert false ) [] sort_cols in let rel_tuples = List.fold_left (fun s l -> match l with | [`String a; `String b; `Int c] -> sprintf "(\"%s\", \"%s\", %d)" a b c :: s | _ -> assert false) [] rel_cols in let obj_tuples = List.fold_left (fun s l -> match l with | [`String a; `String b; `String c; `Int d] -> sprintf "(\"%s\", \"%s\", \"%s\", %d)" a b c d :: s | [`String a; `String b; `String c; `Null] -> sprintf "(\"%s\", \"%s\", \"%s\", %s)" a b c "NULL" :: s | _ -> assert false) [] obj_cols in if sort_tuples <> [] then begin let query_sort = sprintf "INSERT %s VALUES %s;" (sort_tbl ()) (String.concat "," sort_tuples) in ignore (Mysql.exec dbd query_sort) end; if rel_tuples <> [] then begin let query_rel = sprintf "INSERT %s VALUES %s;" (rel_tbl ()) (String.concat "," rel_tuples) in ignore (Mysql.exec dbd query_rel) end; if obj_tuples <> [] then begin let query_obj = sprintf "INSERT %s VALUES %s;" (obj_tbl ()) (String.concat "," obj_tuples) in ignore (Mysql.exec dbd query_obj) end let count_distinct position l = MetadataConstraints.UriManagerSet.cardinal (List.fold_left (fun acc d -> match position with | `Conclusion -> (match d with | `Obj (name,`InConclusion) | `Obj (name,`MainConclusion _ ) -> MetadataConstraints.UriManagerSet.add name acc | _ -> acc) | `Hypothesis -> (match d with | `Obj (name,`InHypothesis) | `Obj (name,`MainHypothesis _) -> MetadataConstraints.UriManagerSet.add name acc | _ -> acc) | `Statement -> (match d with | `Obj (name,`InBody) -> acc | `Obj (name,_) -> MetadataConstraints.UriManagerSet.add name acc | _ -> acc) ) MetadataConstraints.UriManagerSet.empty l) (* let insert_const_no dbd uri = let term = CicUtil.term_of_uri uri in let ty = CicTypeChecker.type_of_aux' let inconcl_no = sprintf "INSERT %s SELECT \"%s\", COUNT(DISTINCT h_occurrence) FROM %s WHERE (h_position=\"%s\" OR h_position=\"%s\") AND source LIKE \"%s%%\"" (conclno_tbl ()) uri (obj_tbl ()) inconcl_pos mainconcl_pos uri in let concl_hyp = sprintf "INSERT %s SELECT \"%s\",COUNT(DISTINCT h_occurrence) FROM %s WHERE NOT (h_position=\"%s\") AND (source = \"%s\")" (fullno_tbl ()) uri (obj_tbl ()) inbody_pos uri in ignore (Mysql.exec dbd inconcl_no); ignore (Mysql.exec dbd concl_hyp) *) let insert_const_no dbd (uri,metadata) = let no_concl = count_distinct `Conclusion metadata in let no_hyp = count_distinct `Hypothesis metadata in let no_full = count_distinct `Statement metadata in let insert = sprintf "INSERT INTO %s VALUES (\"%s\", %d, %d, %d)" (count_tbl ()) (UriManager.string_of_uri uri) no_concl no_hyp no_full in ignore (Mysql.exec dbd insert) let insert_name ~dbd ~uri ~name = let query = sprintf "INSERT %s VALUES (\"%s\", \"%s\")" (name_tbl ()) (UriManager.string_of_uri uri) name in ignore (Mysql.exec dbd query) type columns = MetadataPp.t list list * MetadataPp.t list list * MetadataPp.t list list (* TODO ZACK: verify if an object has already been indexed *) let already_indexed _ = false (* let index_constant ~dbd = let query = prepare_insert () in fun ~uri ~body ~ty -> if not (already_indexed uri) then beginrel_tbl () let name = UriManager.name_of_uri uri in let uri = UriManager.string_of_uri uri in let metadata = MetadataExtractor.compute ~body ~ty in let columns = MetadataPp.columns_of_metadata ~about:uri metadata in execute_insert dbd query uri (columns :> columns); insert_const_no dbd uri; insert_name ~dbd ~uri ~name end let index_inductive_def ~dbd = let query = prepare_insert () in fun ~uri ~types -> if not (already_indexed uri) then begin let metadata = MetadataExtractor.compute_obj uri in let uri_of (a,b,c) = a in let uris = UriManager.string_of_uri uri :: List.map uri_of metadata in let uri = UriManager.string_of_uri uri in let columns = MetadataPp.columns_of_ind_metadata metadata in execute_insert dbd query uri (columns :> columns); List.iter (insert_const_no dbd) uris; List.iter (fun (uri, name, _) -> insert_name ~dbd ~uri ~name) metadata end *) (***** TENTATIVE HACK FOR THE DB SLOWDOWN - BEGIN *******) let analyze_index = ref 0 let eventually_analyze dbd = incr analyze_index; if !analyze_index > 30 then begin let analyze t = "OPTIMIZE TABLE " ^ t ^ ";" in List.iter (fun table -> ignore (Mysql.exec dbd (analyze table))) [name_tbl (); rel_tbl (); sort_tbl (); obj_tbl(); count_tbl()] end (***** TENTATIVE HACK FOR THE DB SLOWDOWN - END *******) let index_obj ~dbd ~uri = if not (already_indexed uri) then begin eventually_analyze dbd; let metadata = MetadataExtractor.compute_obj uri in let uri_of (a,b,c) = (a,c) in let uri = UriManager.string_of_uri uri in let columns = MetadataPp.columns_of_metadata metadata in execute_insert dbd uri (columns :> columns); List.iter (insert_const_no dbd) (List.map uri_of metadata); List.iter (fun (uri, name, _) -> insert_name ~dbd ~uri ~name) metadata end let tables_to_clean = [sort_tbl; rel_tbl; obj_tbl; name_tbl; count_tbl] let clean ~(dbd:Mysql.dbd) = let owned_uris = (* list of uris in list-of-columns format *) let query = sprintf "SELECT source FROM %s" (name_tbl ()) in let result = Mysql.exec dbd query in let uris = Mysql.map result (fun cols -> match cols.(0) with | Some src -> src | None -> assert false) in (* and now some stuff to remove #xpointers and duplicates *) uris in let del_from tbl = let query s = sprintf "DELETE FROM %s WHERE source LIKE \"%s%%\"" (tbl ()) s in List.iter (fun source_col -> ignore (Mysql.exec dbd (query source_col))) owned_uris in List.iter del_from tables_to_clean; owned_uris let unindex ~dbd ~uri = let uri = UriManager.string_of_uri uri in let del_from tbl = let query tbl = sprintf "DELETE FROM %s WHERE source LIKE \"%s%%\"" (tbl ()) uri in ignore (Mysql.exec dbd (query tbl)) in List.iter del_from tables_to_clean