]> matita.cs.unibo.it Git - helm.git/blob - helm/software/components/metadata/sqlStatements.ml
added margin option to the pp
[helm.git] / helm / software / components / metadata / sqlStatements.ml
1 (* Copyright (C) 2004-2005, HELM Team.
2  * 
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.
6  * 
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.
11  * 
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.
16  *
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,
20  * MA  02111-1307, USA.
21  * 
22  * For details, see the HELM World-Wide-Web page,
23  * http://helm.cs.unibo.it/
24  *)
25
26 (* $Id$ *)
27
28 open Printf;;
29 type tbl = [ `RefObj| `RefSort| `RefRel| `ObjectName| `Hits| `Count]
30
31 (* TABLES *)
32
33 let sprintf_refObj_format name = [
34 sprintf "CREATE TABLE %s (
35     source varchar(255) not null,
36     h_occurrence varchar(255) not null,
37     h_position varchar(62) not null,
38     h_depth integer
39 );" name]
40
41 let sprintf_refSort_format name = [
42 sprintf "CREATE TABLE %s (
43     source varchar(255) not null,
44     h_position varchar(62) not null,
45     h_depth integer not null,
46     h_sort varchar(5) not null
47 );" name]
48
49 let sprintf_refRel_format name = [
50 sprintf "CREATE TABLE %s (
51     source varchar(255) not null,
52     h_position varchar(62) not null,
53     h_depth integer not null
54 );" name]
55
56 let sprintf_objectName_format name = [
57 sprintf "CREATE TABLE %s (
58     source varchar(255) not null,
59     value varchar(255) not null
60 );" name]
61
62 let sprintf_hits_format name = [
63 sprintf "CREATE TABLE %s (
64     source varchar(255) not null,
65     no integer not null
66 );" name]
67
68 let sprintf_count_format name = [
69 sprintf "CREATE TABLE %s (
70     source varchar(255) unique not null,
71     conclusion smallint(6) not null,
72     hypothesis smallint(6) not null,
73     statement smallint(6) not null
74 );" name]
75
76 let sprintf_refObj_drop name = [sprintf "DROP TABLE %s;" name]
77
78 let sprintf_refSort_drop name = [sprintf "DROP TABLE %s;" name]
79
80 let sprintf_refRel_drop name = [sprintf "DROP TABLE %s;" name]
81
82 let sprintf_objectName_drop name = [sprintf "DROP TABLE %s;" name]
83
84 let sprintf_hits_drop name = [sprintf "DROP TABLE %s;" name]
85
86 let sprintf_count_drop name = [sprintf "DROP TABLE %s;" name]
87
88 (* INDEXES *)
89
90 let sprintf_refObj_index name = [
91 sprintf "CREATE INDEX %s_index ON %s (source,h_occurrence,h_position);" name name;
92 (*sprintf "CREATE INDEX %s_index ON %s (source(219),h_occurrence(219),h_position);" name name;*)
93 sprintf "CREATE INDEX %s_occurrence ON %s (h_occurrence);" name name ]
94
95 let sprintf_refSort_index name = [
96 sprintf "CREATE INDEX %s_index ON %s (source,h_sort,h_position,h_depth);" name name]
97
98 let sprintf_objectName_index name = [
99 sprintf "CREATE INDEX %s_value ON %s (value);" name name]
100
101 let sprintf_hits_index name = [
102 sprintf "CREATE INDEX %s_source ON %s (source);" name name ;
103 sprintf "CREATE INDEX %s_no ON %s (no);" name name] 
104
105 let sprintf_count_index name = [
106 sprintf "CREATE INDEX %s_conclusion ON %s (conclusion);" name name;
107 sprintf "CREATE INDEX %s_hypothesis ON %s (hypothesis);" name name;
108 sprintf "CREATE INDEX %s_statement ON %s (statement);" name name]
109  
110 let sprintf_refRel_index name = [
111 sprintf "CREATE INDEX %s_index ON %s (source,h_position,h_depth);" name name]
112
113 let format_drop name sufix dtype dbd =
114   if HSql.isMysql dtype dbd then
115         (sprintf "DROP INDEX %s_%s ON %s;" name sufix name)
116      else
117         (sprintf "DROP INDEX %s_%s;" name sufix);;
118
119 let sprintf_refObj_index_drop name  dtype dbd= [(format_drop name "index" dtype dbd)]
120
121 let sprintf_refSort_index_drop name dtype dbd = [(format_drop name "index" dtype dbd)]
122
123 let sprintf_objectName_index_drop name dtype dbd = [(format_drop name "value" dtype dbd)]
124
125 let sprintf_hits_index_drop name dtype dbd = [
126 (format_drop name "source" dtype dbd);
127 (format_drop name "no" dtype dbd)] 
128
129 let sprintf_count_index_drop name dtype dbd = [
130 (format_drop name "source" dtype dbd);
131 (format_drop name "conclusion" dtype dbd);
132 (format_drop name "hypothesis" dtype dbd);
133 (format_drop name "statement" dtype dbd)]
134  
135 let sprintf_refRel_index_drop name dtype dbd = 
136   [(format_drop name "index" dtype dbd)]
137
138 let sprintf_rename_table oldname newname = [
139 sprintf "RENAME TABLE %s TO %s;" oldname newname 
140 ]
141           
142
143 (* FUNCTIONS *)
144
145 let get_table_format t named =
146   match t with
147   | `RefObj -> sprintf_refObj_format named
148   | `RefSort -> sprintf_refSort_format named
149   | `RefRel -> sprintf_refRel_format named
150   | `ObjectName -> sprintf_objectName_format named
151   | `Hits -> sprintf_hits_format named
152   | `Count -> sprintf_count_format named
153
154 let get_index_format t named =
155   match t with
156   | `RefObj -> sprintf_refObj_index named
157   | `RefSort -> sprintf_refSort_index named
158   | `RefRel -> sprintf_refRel_index named
159   | `ObjectName -> sprintf_objectName_index named
160   | `Hits -> sprintf_hits_index named
161   | `Count -> sprintf_count_index named
162
163 let get_table_drop t named =
164   match t with
165   | `RefObj -> sprintf_refObj_drop named
166   | `RefSort -> sprintf_refSort_drop named
167   | `RefRel -> sprintf_refRel_drop named
168   | `ObjectName -> sprintf_objectName_drop named
169   | `Hits -> sprintf_hits_drop named
170   | `Count -> sprintf_count_drop named
171
172 let get_index_drop t named dtype dbd =
173   match t with
174   | `RefObj -> sprintf_refObj_index_drop named dtype dbd
175   | `RefSort -> sprintf_refSort_index_drop named dtype dbd
176   | `RefRel -> sprintf_refRel_index_drop named dtype dbd
177   | `ObjectName -> sprintf_objectName_index_drop named dtype dbd
178   | `Hits -> sprintf_hits_index_drop named dtype dbd
179   | `Count -> sprintf_count_index_drop named dtype dbd
180
181 let create_tables l =
182   List.fold_left (fun s (name,table) ->  s @ get_table_format table name) [] l
183
184 let create_indexes l =
185   List.fold_left (fun s (name,table) ->  s @ get_index_format table name) [] l
186  
187 let drop_tables l =
188   List.fold_left (fun s (name,table) ->  s @ get_table_drop table name) [] l
189   
190 let drop_indexes l  dtype dbd=
191   List.fold_left (fun s (name,table) ->  s @ get_index_drop table name dtype dbd) [] l
192
193 let rename_tables l = 
194   List.fold_left (fun s (o,n) ->  s @ sprintf_rename_table o n) [] l
195
196 let fill_hits refObj hits =
197   [ sprintf
198         "INSERT INTO %s
199         SELECT h_occurrence, COUNT(source)
200         FROM %s
201         GROUP BY h_occurrence;"
202       hits refObj ]
203
204
205 let move_content (name1, tbl1) (name2, tbl2) buri dtype dbd  =
206   let escape s =
207       Pcre.replace ~pat:"([^\\\\])_" ~templ:"$1\\_" (HSql.escape dtype dbd s)
208   in
209   assert (tbl1 = tbl2);
210   sprintf 
211     "INSERT INTRO %s SELECT * FROM %s WHERE source LIKE \"%s%%\";"   
212     name2 name1 (escape buri)
213
214 let direct_deps refObj uri dtype dbd =
215   sprintf "SELECT * FROM %s WHERE source = \"%s\";"
216     refObj (HSql.escape dtype dbd (UriManager.string_of_uri uri))
217
218 let inverse_deps refObj uri dtype dbd =
219   sprintf "SELECT * FROM %s WHERE h_occurrence = \"%s\";"
220     refObj (HSql.escape dtype dbd (UriManager.string_of_uri uri))
221