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 prepare_insert () =
32 let insert_owner a b =
33 sprintf "INSERT %s VALUES (\"%s\", \"%s\")" (owners_tbl ())a b
36 let insert_sort a b c d =
37 sprintf "INSERT %s VALUES (\"%s\", \"%s\", %d, \"%s\")" (sort_tbl ())a b c d
39 let insert_rel a b c =
40 sprintf "INSERT %s VALUES (\"%s\", \"%s\", %d)" (rel_tbl ()) a b c
42 let insert_obj a b c d =
43 sprintf "INSERT %s VALUES (\"%s\", \"%s\", \"%s\", %s)" (obj_tbl ()) a b c d
45 ((*insert_owner, *)insert_sort, insert_rel, insert_obj)
47 let execute_insert dbd ((*insert_owner, *)insert_sort, insert_rel, insert_obj)
48 uri owner (sort_cols, rel_cols, obj_cols)
50 (* ignore (Mysql.exec dbd (insert_owner uri owner)); *)
52 | [`String a; `String b; `Int c; `String d] ->
53 ignore (Mysql.exec dbd (insert_sort a b c d))
57 | [`String a; `String b; `Int c] ->
58 ignore (Mysql.exec dbd (insert_rel a b c))
62 | [`String a; `String b; `String c; `Int d] ->
63 ignore (Mysql.exec dbd (insert_obj a b c (string_of_int d)))
64 | [`String a; `String b; `String c; `Null] ->
65 ignore (Mysql.exec dbd (insert_obj a b c "NULL"))
69 let insert_const_no dbd uri =
71 sprintf "INSERT %s SELECT \"%s\", COUNT(DISTINCT h_occurrence) FROM %s WHERE (h_position=\"%s\" OR h_position=\"%s\") AND source LIKE \"%s%%\""
72 (conclno_tbl ()) uri (obj_tbl ()) inconcl_pos mainconcl_pos uri
76 SELECT \"%s\",COUNT(DISTINCT h_occurrence)
78 WHERE NOT (h_position=\"%s\") AND (source = \"%s\")"
79 (conclno_hyp_tbl ()) uri (obj_tbl ()) inbody_pos uri
81 ignore (Mysql.exec dbd inconcl_no);
82 ignore (Mysql.exec dbd concl_hyp)
84 let insert_name ~dbd ~uri ~name =
86 sprintf "INSERT %s VALUES (\"%s\", \"%s\")" (name_tbl ()) uri name
88 ignore (Mysql.exec dbd query)
91 MetadataPp.t list list * MetadataPp.t list list * MetadataPp.t list list
93 let index_constant ~dbd =
94 let query = prepare_insert () in
95 fun ~owner ~uri ~body ~ty ->
96 let name = UriManager.name_of_uri uri in
97 let uri = UriManager.string_of_uri uri in
98 let metadata = MetadataExtractor.compute ~body ~ty in
99 let columns = MetadataPp.columns_of_metadata ~about:uri metadata in
100 execute_insert dbd query uri owner (columns :> columns);
101 insert_const_no dbd uri;
102 insert_name ~dbd ~uri ~name
104 let index_inductive_def ~dbd =
105 let query = prepare_insert () in
106 fun ~owner ~uri ~types ->
107 let metadata = MetadataExtractor.compute_ind ~uri ~types in
108 let uri_of (a,b,c) = a in
109 let uris = UriManager.string_of_uri uri :: List.map uri_of metadata in
110 let uri = UriManager.string_of_uri uri in
111 let columns = MetadataPp.columns_of_ind_metadata metadata in
112 execute_insert dbd query uri owner (columns :> columns);
113 List.iter (insert_const_no dbd) uris;
114 List.iter (fun (uri, name, _) -> insert_name ~dbd ~uri ~name) metadata
116 let clean ~(dbd:Mysql.dbd) =
117 let owned_uris = (* list of uris in list-of-columns format *)
120 * "SELECT source FROM %s WHERE owner = \"%s\"" (owners_tbl ())
122 sprintf "SELECT source FROM %s" (obj_tbl ())
124 let result = Mysql.exec dbd query in
125 let uris = Mysql.map result (fun cols ->
128 | None -> assert false) in
129 (* and now some stuff to remove #xpointers and duplicates *)
131 List.map (fun x -> Str.replace_first (Str.regexp "\#.*$") "" x) uris
133 let sorted_uris = List.fast_sort Pervasives.compare cleaned_uris in
134 match sorted_uris with
137 (* no List.remove dups ?? *)
138 snd(List.fold_left (fun (last,l) cur -> if cur <> last then
139 (cur,cur::l) else (last,l)) (he,[he]) tl)
143 sprintf "DELETE FROM %s WHERE source LIKE \"%s%%\"" (tbl ()) s
146 (fun source_col -> ignore (Mysql.exec dbd (query source_col)))
150 [sort_tbl; rel_tbl; obj_tbl; conclno_tbl; conclno_hyp_tbl; name_tbl(*;
152 List.iter Http_getter.unregister owned_uris