1 (* Copyright (C) 2004, 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/
30 let execute_insert dbd uri (sort_cols, rel_cols, obj_cols) =
32 List.fold_left (fun s l -> match l with
33 | [`String a; `String b; `Int c; `String d] ->
34 sprintf "(\"%s\", \"%s\", %d, \"%s\")" a b c d :: s
39 List.fold_left (fun s l -> match l with
40 | [`String a; `String b; `Int c] ->
41 sprintf "(\"%s\", \"%s\", %d)" a b c :: s
45 let obj_tuples = List.fold_left (fun s l -> match l with
46 | [`String a; `String b; `String c; `Int d] ->
47 sprintf "(\"%s\", \"%s\", \"%s\", %d)" a b c d :: s
48 | [`String a; `String b; `String c; `Null] ->
49 sprintf "(\"%s\", \"%s\", \"%s\", %s)" a b c "NULL" :: s
53 if sort_tuples <> [] then
56 sprintf "INSERT %s VALUES %s;" (sort_tbl ()) (String.concat "," sort_tuples)
58 ignore (Mysql.exec dbd query_sort)
60 if rel_tuples <> [] then
63 sprintf "INSERT %s VALUES %s;" (rel_tbl ()) (String.concat "," rel_tuples)
65 ignore (Mysql.exec dbd query_rel)
67 if obj_tuples <> [] then
70 sprintf "INSERT %s VALUES %s;" (obj_tbl ()) (String.concat "," obj_tuples)
72 ignore (Mysql.exec dbd query_obj)
75 let insert_const_no dbd uri =
77 sprintf "INSERT %s SELECT \"%s\", COUNT(DISTINCT h_occurrence) FROM %s WHERE (h_position=\"%s\" OR h_position=\"%s\") AND source LIKE \"%s%%\""
78 (conclno_tbl ()) uri (obj_tbl ()) inconcl_pos mainconcl_pos uri
82 SELECT \"%s\",COUNT(DISTINCT h_occurrence)
84 WHERE NOT (h_position=\"%s\") AND (source = \"%s\")"
85 (fullno_tbl ()) uri (obj_tbl ()) inbody_pos uri
87 ignore (Mysql.exec dbd inconcl_no);
88 ignore (Mysql.exec dbd concl_hyp)
90 let insert_name ~dbd ~uri ~name =
92 sprintf "INSERT %s VALUES (\"%s\", \"%s\")" (name_tbl ()) uri name
94 ignore (Mysql.exec dbd query)
97 MetadataPp.t list list * MetadataPp.t list list * MetadataPp.t list list
99 (* TODO ZACK: verify if an object has already been indexed *)
100 let already_indexed _ = false
102 let index_constant ~dbd =
103 let query = prepare_insert () in
104 fun ~uri ~body ~ty ->
105 if not (already_indexed uri) then begin
106 let name = UriManager.name_of_uri uri in
107 let uri = UriManager.string_of_uri uri in
108 let metadata = MetadataExtractor.compute ~body ~ty in
109 let columns = MetadataPp.columns_of_metadata ~about:uri metadata in
110 execute_insert dbd query uri (columns :> columns);
111 insert_const_no dbd uri;
112 insert_name ~dbd ~uri ~name
115 let index_inductive_def ~dbd =
116 let query = prepare_insert () in
118 if not (already_indexed uri) then begin
119 let metadata = MetadataExtractor.compute_obj uri in
120 let uri_of (a,b,c) = a in
121 let uris = UriManager.string_of_uri uri :: List.map uri_of metadata in
122 let uri = UriManager.string_of_uri uri in
123 let columns = MetadataPp.columns_of_ind_metadata metadata in
124 execute_insert dbd query uri (columns :> columns);
125 List.iter (insert_const_no dbd) uris;
126 List.iter (fun (uri, name, _) -> insert_name ~dbd ~uri ~name) metadata
129 let index_obj ~dbd ~uri =
130 if not (already_indexed uri) then begin
131 let metadata = MetadataExtractor.compute_obj uri in
132 let uri_of (a,b,c) = a in
133 let uris = UriManager.string_of_uri uri :: List.map uri_of metadata in
134 let uri = UriManager.string_of_uri uri in
135 let columns = MetadataPp.columns_of_metadata metadata in
136 execute_insert dbd uri (columns :> columns);
137 List.iter (insert_const_no dbd) uris;
138 List.iter (fun (uri, name, _) -> insert_name ~dbd ~uri ~name) metadata
142 let tables_to_clean =
143 [sort_tbl; rel_tbl; obj_tbl; conclno_tbl; fullno_tbl; name_tbl; hypno_tbl]
145 let clean ~(dbd:Mysql.dbd) =
146 let owned_uris = (* list of uris in list-of-columns format *)
147 let query = sprintf "SELECT source FROM %s" (obj_tbl ()) in
148 let result = Mysql.exec dbd query in
149 let uris = Mysql.map result (fun cols ->
152 | None -> assert false) in
153 (* and now some stuff to remove #xpointers and duplicates *)
158 sprintf "DELETE FROM %s WHERE source LIKE \"%s%%\"" (tbl ()) s
161 (fun source_col -> ignore (Mysql.exec dbd (query source_col)))
164 List.iter del_from tables_to_clean;
167 let unindex ~dbd ~uri =
168 let uri = UriManager.string_of_uri uri in
171 sprintf "DELETE FROM %s WHERE source LIKE \"%s%%\"" (tbl ()) uri
173 ignore (Mysql.exec dbd (query tbl))
175 List.iter del_from tables_to_clean