Mercurial > urweb
comparison src/mysql.sml @ 1953:0992323fa264
noMangleSql .urp directive
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sat, 04 Jan 2014 19:02:14 -0500 |
parents | 6745eafff617 |
children | 1802eb00a0ae |
comparison
equal
deleted
inserted
replaced
1952:cf7f7e51b0a2 | 1953:0992323fa264 |
---|---|
74 | ch => str ch) | 74 | ch => str ch) |
75 | 75 |
76 fun checkRel (table, checkNullable) (s, xts) = | 76 fun checkRel (table, checkNullable) (s, xts) = |
77 let | 77 let |
78 val sl = CharVector.map Char.toLower s | 78 val sl = CharVector.map Char.toLower s |
79 val both = "table_name IN ('" ^ sl ^ "', '" ^ s ^ "')" | 79 val sl = if size sl > 1 andalso String.sub (sl, 0) = #"\"" then |
80 String.substring (sl, 1, size sl - 2) | |
81 else | |
82 sl | |
83 val both = "LOWER(table_name) = ('" ^ sl ^ "')" | |
80 | 84 |
81 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE " ^ both | 85 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE " ^ both |
82 | 86 |
83 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ", | 87 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ", |
84 both, | 88 both, |
85 " AND (", | 89 " AND (", |
86 case String.concatWith " OR " | 90 case String.concatWith " OR " |
87 (map (fn (x, t) => | 91 (map (fn (x, t) => |
88 String.concat ["(column_name IN ('uw_", | 92 String.concat ["(LOWER(column_name) = '", |
89 CharVector.map | 93 Settings.mangleSqlCatalog |
90 Char.toLower (ident x), | 94 (CharVector.map |
91 "', 'uw_", | 95 Char.toLower (ident x)), |
92 ident x, | 96 "' AND data_type ", |
93 "') AND data_type = '", | 97 case p_sql_type_base t of |
94 p_sql_type_base t, | 98 "bigint" => |
95 "'", | 99 "IN ('bigint', 'int')" |
100 | "longtext" => | |
101 "IN ('longtext', 'varchar')" | |
102 | s => "= '" ^ s ^ "'", | |
96 if checkNullable then | 103 if checkNullable then |
97 (" AND is_nullable = '" | 104 (" AND is_nullable = '" |
98 ^ (if isNotNull t then | 105 ^ (if isNotNull t then |
99 "NO" | 106 "NO" |
100 else | 107 else |
107 | s => s, | 114 | s => s, |
108 ")"] | 115 ")"] |
109 | 116 |
110 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ", | 117 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ", |
111 both, | 118 both, |
112 " AND column_name LIKE 'uw_%'"] | 119 " AND LOWER(column_name) LIKE '", Settings.mangleSqlCatalog "%'"] |
113 in | 120 in |
114 box [string "if (mysql_query(conn->conn, \"", | 121 box [string "if (mysql_query(conn->conn, \"", |
115 string q, | 122 string q, |
116 string "\")) {", | 123 string "\")) {", |
117 newline, | 124 newline, |
172 box [string "mysql_free_result(res);", | 179 box [string "mysql_free_result(res);", |
173 newline, | 180 newline, |
174 string "mysql_close(conn->conn);", | 181 string "mysql_close(conn->conn);", |
175 newline, | 182 newline, |
176 string "uw_error(ctx, FATAL, \"Table '", | 183 string "uw_error(ctx, FATAL, \"Table '", |
177 string s, | 184 string sl, |
178 string "' does not exist.\");", | 185 string "' does not exist.\");", |
179 newline], | 186 newline], |
180 string "}", | 187 string "}", |
181 newline, | 188 newline, |
182 newline, | 189 newline, |
247 box [string "mysql_free_result(res);", | 254 box [string "mysql_free_result(res);", |
248 newline, | 255 newline, |
249 string "mysql_close(conn->conn);", | 256 string "mysql_close(conn->conn);", |
250 newline, | 257 newline, |
251 string "uw_error(ctx, FATAL, \"Table '", | 258 string "uw_error(ctx, FATAL, \"Table '", |
252 string s, | 259 string sl, |
253 string "' has the wrong column types.\");", | 260 string "' has the wrong column types.\");", |
254 newline], | 261 newline], |
255 string "}", | 262 string "}", |
256 newline, | 263 newline, |
257 newline, | 264 newline, |
322 box [string "mysql_free_result(res);", | 329 box [string "mysql_free_result(res);", |
323 newline, | 330 newline, |
324 string "mysql_close(conn->conn);", | 331 string "mysql_close(conn->conn);", |
325 newline, | 332 newline, |
326 string "uw_error(ctx, FATAL, \"Table '", | 333 string "uw_error(ctx, FATAL, \"Table '", |
327 string s, | 334 string sl, |
328 string "' has extra columns.\");", | 335 string "' has extra columns.\");", |
329 newline], | 336 newline], |
330 string "}", | 337 string "}", |
331 newline, | 338 newline, |
332 newline, | 339 newline, |
1199 newline] | 1206 newline] |
1200 else | 1207 else |
1201 box []] | 1208 box []] |
1202 | 1209 |
1203 fun dmlCommon {loc, dml, mode} = | 1210 fun dmlCommon {loc, dml, mode} = |
1204 box [string "if (mysql_stmt_execute(stmt)) ", | 1211 box [string "if (mysql_stmt_execute(stmt)) {", |
1205 case mode of | 1212 box [string "if (mysql_errno(conn->conn) == 1213)", |
1206 Settings.Error => box [string "uw_error(ctx, FATAL, \"", | 1213 newline, |
1207 string (ErrorMsg.spanToString loc), | 1214 box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");", |
1208 string ": Error executing DML: %s\\n%s\", ", | 1215 newline], |
1209 dml, | 1216 newline, |
1210 string ", mysql_error(conn->conn));"] | 1217 case mode of |
1211 | Settings.None => string "uw_set_error_message(ctx, mysql_error(conn->conn));", | 1218 Settings.Error => box [string "uw_error(ctx, FATAL, \"", |
1212 newline, | 1219 string (ErrorMsg.spanToString loc), |
1220 string ": Error executing DML: %s\\n%s\", ", | |
1221 dml, | |
1222 string ", mysql_error(conn->conn));"] | |
1223 | Settings.None => string "uw_set_error_message(ctx, mysql_error(conn->conn));", | |
1224 newline], | |
1225 string "}", | |
1213 newline] | 1226 newline] |
1214 | 1227 |
1215 fun dml (loc, mode) = | 1228 fun dml (loc, mode) = |
1216 box [string "uw_conn *conn = uw_get_db(ctx);", | 1229 box [string "uw_conn *conn = uw_get_db(ctx);", |
1217 newline, | 1230 newline, |