Mercurial > urweb

comparison src/mysql.sml @ 1953:0992323fa264

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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,