Mercurial > urweb

comparison src/postgres.sml @ 870:7fa9a37a34b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move all DBMS initialization to #init
author Adam Chlipala <adamc@hcoop.net>
date Tue, 30 Jun 2009 15:45:10 -0400
parents 64ba57fa20bf
children 3ae6b655ced0
comparison
equal deleted inserted replaced
869:64ba57fa20bf 870:7fa9a37a34b3
29 29
30 open Settings 30 open Settings
31 open Print.PD 31 open Print.PD
32 open Print 32 open Print
33 33
34 fun init (dbstring, ss) = 34 val ident = String.translate (fn #"'" => "PRIME"
35 | ch => str ch)
36
37 fun p_sql_type_base t =
38 case t of
39 Int => "int8"
40 | Float => "float8"
41 | String => "text"
42 | Bool => "bool"
43 | Time => "timestamp"
44 | Blob => "bytea"
45 | Channel => "int8"
46 | Client => "int4"
47 | Nullable t => p_sql_type_base t
48
49 fun init {dbstring, prepared = ss, tables, sequences} =
35 box [if #persistent (currentProtocol ()) then 50 box [if #persistent (currentProtocol ()) then
36 box [string "static void uw_db_prepare(uw_context ctx) {", 51 box [string "static void uw_db_validate(uw_context ctx) {",
52 newline,
53 string "PGconn *conn = uw_get_db(ctx);",
54 newline,
55 string "PGresult *res;",
56 newline,
57 newline,
58 p_list_sep newline
59 (fn (s, xts) =>
60 let
61 val sl = CharVector.map Char.toLower s
62
63 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
64 ^ sl ^ "'"
65
66 val q' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
67 sl,
68 "') AND (",
69 String.concatWith " OR "
70 (map (fn (x, t) =>
71 String.concat ["(attname = 'uw_",
72 CharVector.map
73 Char.toLower (ident x),
74 "' AND atttypid = (SELECT oid FROM pg_type",
75 " WHERE typname = '",
76 p_sql_type_base t,
77 "') AND attnotnull = ",
78 if isNotNull t then
79 "TRUE"
80 else
81 "FALSE",
82 ")"]) xts),
83 ")"]
84
85 val q'' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
86 sl,
87 "') AND attname LIKE 'uw_%'"]
88 in
89 box [string "res = PQexec(conn, \"",
90 string q,
91 string "\");",
92 newline,
93 newline,
94 string "if (res == NULL) {",
95 newline,
96 box [string "PQfinish(conn);",
97 newline,
98 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
99 newline],
100 string "}",
101 newline,
102 newline,
103 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
104 newline,
105 box [string "char msg[1024];",
106 newline,
107 string "strncpy(msg, PQerrorMessage(conn), 1024);",
108 newline,
109 string "msg[1023] = 0;",
110 newline,
111 string "PQclear(res);",
112 newline,
113 string "PQfinish(conn);",
114 newline,
115 string "uw_error(ctx, FATAL, \"Query failed:\\n",
116 string q,
117 string "\\n%s\", msg);",
118 newline],
119 string "}",
120 newline,
121 newline,
122 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
123 newline,
124 box [string "PQclear(res);",
125 newline,
126 string "PQfinish(conn);",
127 newline,
128 string "uw_error(ctx, FATAL, \"Table '",
129 string s,
130 string "' does not exist.\");",
131 newline],
132 string "}",
133 newline,
134 newline,
135 string "PQclear(res);",
136 newline,
137
138 string "res = PQexec(conn, \"",
139 string q',
140 string "\");",
141 newline,
142 newline,
143 string "if (res == NULL) {",
144 newline,
145 box [string "PQfinish(conn);",
146 newline,
147 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
148 newline],
149 string "}",
150 newline,
151 newline,
152 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
153 newline,
154 box [string "char msg[1024];",
155 newline,
156 string "strncpy(msg, PQerrorMessage(conn), 1024);",
157 newline,
158 string "msg[1023] = 0;",
159 newline,
160 string "PQclear(res);",
161 newline,
162 string "PQfinish(conn);",
163 newline,
164 string "uw_error(ctx, FATAL, \"Query failed:\\n",
165 string q',
166 string "\\n%s\", msg);",
167 newline],
168 string "}",
169 newline,
170 newline,
171 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
172 string (Int.toString (length xts)),
173 string "\")) {",
174 newline,
175 box [string "PQclear(res);",
176 newline,
177 string "PQfinish(conn);",
178 newline,
179 string "uw_error(ctx, FATAL, \"Table '",
180 string s,
181 string "' has the wrong column types.\");",
182 newline],
183 string "}",
184 newline,
185 newline,
186 string "PQclear(res);",
187 newline,
188 newline,
189
190 string "res = PQexec(conn, \"",
191 string q'',
192 string "\");",
193 newline,
194 newline,
195 string "if (res == NULL) {",
196 newline,
197 box [string "PQfinish(conn);",
198 newline,
199 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
200 newline],
201 string "}",
202 newline,
203 newline,
204 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
205 newline,
206 box [string "char msg[1024];",
207 newline,
208 string "strncpy(msg, PQerrorMessage(conn), 1024);",
209 newline,
210 string "msg[1023] = 0;",
211 newline,
212 string "PQclear(res);",
213 newline,
214 string "PQfinish(conn);",
215 newline,
216 string "uw_error(ctx, FATAL, \"Query failed:\\n",
217 string q'',
218 string "\\n%s\", msg);",
219 newline],
220 string "}",
221 newline,
222 newline,
223 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
224 string (Int.toString (length xts)),
225 string "\")) {",
226 newline,
227 box [string "PQclear(res);",
228 newline,
229 string "PQfinish(conn);",
230 newline,
231 string "uw_error(ctx, FATAL, \"Table '",
232 string s,
233 string "' has extra columns.\");",
234 newline],
235 string "}",
236 newline,
237 newline,
238 string "PQclear(res);",
239 newline]
240 end) tables,
241
242 p_list_sep newline
243 (fn s =>
244 let
245 val sl = CharVector.map Char.toLower s
246
247 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
248 ^ sl ^ "' AND relkind = 'S'"
249 in
250 box [string "res = PQexec(conn, \"",
251 string q,
252 string "\");",
253 newline,
254 newline,
255 string "if (res == NULL) {",
256 newline,
257 box [string "PQfinish(conn);",
258 newline,
259 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
260 newline],
261 string "}",
262 newline,
263 newline,
264 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
265 newline,
266 box [string "char msg[1024];",
267 newline,
268 string "strncpy(msg, PQerrorMessage(conn), 1024);",
269 newline,
270 string "msg[1023] = 0;",
271 newline,
272 string "PQclear(res);",
273 newline,
274 string "PQfinish(conn);",
275 newline,
276 string "uw_error(ctx, FATAL, \"Query failed:\\n",
277 string q,
278 string "\\n%s\", msg);",
279 newline],
280 string "}",
281 newline,
282 newline,
283 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
284 newline,
285 box [string "PQclear(res);",
286 newline,
287 string "PQfinish(conn);",
288 newline,
289 string "uw_error(ctx, FATAL, \"Sequence '",
290 string s,
291 string "' does not exist.\");",
292 newline],
293 string "}",
294 newline,
295 newline,
296 string "PQclear(res);",
297 newline]
298 end) sequences,
299
300 string "}",
301
302 string "static void uw_db_prepare(uw_context ctx) {",
37 newline, 303 newline,
38 string "PGconn *conn = uw_get_db(ctx);", 304 string "PGconn *conn = uw_get_db(ctx);",
39 newline, 305 newline,
40 string "PGresult *res;", 306 string "PGresult *res;",
41 newline, 307 newline,
151 newline, 417 newline,
152 string "}", 418 string "}",
153 newline, 419 newline,
154 newline] 420 newline]
155 else 421 else
156 string "static void uw_db_prepare(uw_context ctx) { }", 422 box [string "static void uw_db_validate(uw_context ctx) { }",
423 newline,
424 string "static void uw_db_prepare(uw_context ctx) { }"],
425
157 newline, 426 newline,
158 newline, 427 newline,
159 428
160 string "void uw_db_init(uw_context ctx) {", 429 string "void uw_db_init(uw_context ctx) {",
161 newline, 430 newline,
220 string ") ? NULL : ", 489 string ") ? NULL : ",
221 case t of 490 case t of
222 String => getter t 491 String => getter t
223 | _ => box [string "({", 492 | _ => box [string "({",
224 newline, 493 newline,
225 p_sql_type t, 494 string (p_sql_type t),
226 space, 495 space,
227 string "*tmp = uw_malloc(ctx, sizeof(", 496 string "*tmp = uw_malloc(ctx, sizeof(",
228 p_sql_type t, 497 string (p_sql_type t),
229 string "));", 498 string "));",
230 newline, 499 newline,
231 string "*tmp = ", 500 string "*tmp = ",
232 getter t, 501 getter t,
233 string ";", 502 string ";",
239 | _ => 508 | _ =>
240 box [string "(PQgetisnull(res, i, ", 509 box [string "(PQgetisnull(res, i, ",
241 string (Int.toString i), 510 string (Int.toString i),
242 string ") ? ", 511 string ") ? ",
243 box [string "({", 512 box [string "({",
244 p_sql_type t, 513 string (p_sql_type t),
245 space, 514 space,
246 string "tmp;", 515 string "tmp;",
247 newline, 516 newline,
248 string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #", 517 string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
249 string (Int.toString i), 518 string (Int.toString i),