Mercurial > urweb

comparison src/postgres.sml @ 1979:81bc76aa4acd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge in upstream changes.
author Patrick Hurst <phurst@mit.edu>
date Sat, 18 Jan 2014 18:26:24 -0500
parents 4ef0c6605b3a
children 661b531f55bd
comparison
equal deleted inserted replaced
1978:c5143edaf3c7 1979:81bc76aa4acd
61 | Nullable t => p_sql_type_base t 61 | Nullable t => p_sql_type_base t
62 62
63 fun checkRel (table, checkNullable) (s, xts) = 63 fun checkRel (table, checkNullable) (s, xts) =
64 let 64 let
65 val sl = CharVector.map Char.toLower s 65 val sl = CharVector.map Char.toLower s
66 val sl = if size sl > 1 andalso String.sub (sl, 0) = #"\"" then
67 String.substring (sl, 1, size sl - 2)
68 else
69 sl
66 70
67 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '" 71 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '"
68 ^ sl ^ "'" 72 ^ sl ^ "'"
69 73
70 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", 74 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
71 sl, 75 sl,
72 "' AND (", 76 "' AND (",
73 case String.concatWith " OR " 77 case String.concatWith " OR "
74 (map (fn (x, t) => 78 (map (fn (x, t) =>
75 String.concat ["(column_name = 'uw_", 79 String.concat ["(LOWER(column_name) = '",
76 CharVector.map 80 Settings.mangleSqlCatalog
77 Char.toLower (ident x), 81 (CharVector.map
82 Char.toLower (ident x)),
78 (case p_sql_type_base t of 83 (case p_sql_type_base t of
79 "bigint" => 84 "bigint" =>
80 "' AND data_type IN ('bigint', 'numeric')" 85 "' AND data_type IN ('bigint', 'numeric', 'integer')"
86 | "text" =>
87 "' AND data_type IN ('text', 'character varying')"
81 | t => 88 | t =>
82 String.concat ["' AND data_type = '", 89 String.concat ["' AND data_type = '",
83 t, 90 t,
84 "'"]), 91 "'"]),
85 if checkNullable then 92 if checkNullable then
96 | s => s, 103 | s => s,
97 ")"] 104 ")"]
98 105
99 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", 106 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
100 sl, 107 sl,
101 "' AND column_name LIKE 'uw_%'"] 108 "' AND LOWER(column_name) LIKE '", Settings.mangleSqlCatalog "%'"]
102 in 109 in
103 box [string "res = PQexec(conn, \"", 110 box [string "res = PQexec(conn, \"",
104 string q, 111 string q,
105 string "\");", 112 string "\");",
106 newline, 113 newline,
138 box [string "PQclear(res);", 145 box [string "PQclear(res);",
139 newline, 146 newline,
140 string "PQfinish(conn);", 147 string "PQfinish(conn);",
141 newline, 148 newline,
142 string "uw_error(ctx, FATAL, \"Table '", 149 string "uw_error(ctx, FATAL, \"Table '",
143 string s, 150 string sl,
144 string "' does not exist.\");", 151 string "' does not exist.\");",
145 newline], 152 newline],
146 string "}", 153 string "}",
147 newline, 154 newline,
148 newline, 155 newline,
189 box [string "PQclear(res);", 196 box [string "PQclear(res);",
190 newline, 197 newline,
191 string "PQfinish(conn);", 198 string "PQfinish(conn);",
192 newline, 199 newline,
193 string "uw_error(ctx, FATAL, \"Table '", 200 string "uw_error(ctx, FATAL, \"Table '",
194 string s, 201 string sl,
195 string "' has the wrong column types.\");", 202 string "' has the wrong column types.\");",
196 newline], 203 newline],
197 string "}", 204 string "}",
198 newline, 205 newline,
199 newline, 206 newline,
241 box [string "PQclear(res);", 248 box [string "PQclear(res);",
242 newline, 249 newline,
243 string "PQfinish(conn);", 250 string "PQfinish(conn);",
244 newline, 251 newline,
245 string "uw_error(ctx, FATAL, \"Table '", 252 string "uw_error(ctx, FATAL, \"Table '",
246 string s, 253 string sl,
247 string "' has extra columns.\");", 254 string "' has extra columns.\");",
248 newline], 255 newline],
249 string "}", 256 string "}",
250 newline, 257 newline,
251 newline, 258 newline,
400 newline, 407 newline,
401 string "}", 408 string "}",
402 newline, 409 newline,
403 newline, 410 newline,
404 411
405 string "static int uw_db_begin(uw_context ctx) {", 412 string "static int uw_db_begin(uw_context ctx, int could_write) {",
406 newline, 413 newline,
407 string "PGconn *conn = uw_get_db(ctx);", 414 string "PGconn *conn = uw_get_db(ctx);",
408 newline, 415 newline,
409 string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");", 416 string "PGresult *res = PQexec(conn, could_write ? \"BEGIN ISOLATION LEVEL SERIALIZABLE\" : \"BEGIN ISOLATION LEVEL SERIALIZABLE, READ ONLY\");",
410 newline, 417 newline,
411 newline, 418 newline,
412 string "if (res == NULL) return 1;", 419 string "if (res == NULL) return 1;",
413 newline, 420 newline,
414 newline, 421 newline,
436 newline, 443 newline,
437 string "if (res == NULL) return 1;", 444 string "if (res == NULL) return 1;",
438 newline, 445 newline,
439 newline, 446 newline,
440 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", 447 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
441 box [string "PQclear(res);", 448 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
449 box [newline,
450 string "PQclear(res);",
451 newline,
452 string "return -1;",
453 newline],
454 string "}",
455 newline,
456 string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
457 box [newline,
458 string "PQclear(res);",
459 newline,
460 string "return -1;",
461 newline],
462 string "}",
463 newline,
464 string "PQclear(res);",
442 newline, 465 newline,
443 string "return 1;", 466 string "return 1;",
444 newline], 467 newline],
445 string "}", 468 string "}",
446 newline, 469 newline,