comparison src/mysql.sml @ 888:ba3569f4fe89

Fix month off-by-one for MySQL timestamps
author Adam Chlipala <adamc@hcoop.net>
date Fri, 17 Jul 2009 17:14:23 -0400
parents 5805fa825fe8
children bcad392e288e
comparison
equal deleted inserted replaced
887:9eb479691d1c 888:ba3569f4fe89
664 string "MYSQL_TIME *mt = &buffer", 664 string "MYSQL_TIME *mt = &buffer",
665 string (Int.toString i), 665 string (Int.toString i),
666 string ";", 666 string ";",
667 newline, 667 newline,
668 newline, 668 newline,
669 string "struct tm t = {mt->second, mt->minute, mt->hour, mt->day, mt->month, mt->year, 0, 0, -1};", 669 string "struct tm t = {mt->second, mt->minute, mt->hour, mt->day, mt->month-1, mt->year, 0, 0, -1};",
670 newline, 670 newline,
671 string "mktime(&t);", 671 string "mktime(&t);",
672 newline, 672 newline,
673 string "})"] 673 string "})"]
674 | _ => box [string "buffer", 674 | _ => box [string "buffer",
973 if nested then 973 if nested then
974 box [] 974 box []
975 else 975 else
976 box [string "}", 976 box [string "}",
977 newline], 977 newline],
978 newline,
979
980 string "memset(in, 0, sizeof in);",
981 newline,
982 p_list_sepi (box []) (fn i => fn t =>
983 let
984 fun buffers t =
985 case t of
986 String => box [string "in[",
987 string (Int.toString i),
988 string "].buffer = arg",
989 string (Int.toString (i + 1)),
990 string ";",
991 newline,
992 string "in_length",
993 string (Int.toString i),
994 string "= in[",
995 string (Int.toString i),
996 string "].buffer_length = strlen(arg",
997 string (Int.toString (i + 1)),
998 string ");",
999 newline,
1000 string "in[",
1001 string (Int.toString i),
1002 string "].length = &in_length",
1003 string (Int.toString i),
1004 string ";",
1005 newline]
1006 | Blob => box [string "in[",
1007 string (Int.toString i),
1008 string "].buffer = arg",
1009 string (Int.toString (i + 1)),
1010 string ".data;",
1011 newline,
1012 string "in_length",
1013 string (Int.toString i),
1014 string "= in[",
1015 string (Int.toString i),
1016 string "].buffer_length = arg",
1017 string (Int.toString (i + 1)),
1018 string ".size;",
1019 newline,
1020 string "in[",
1021 string (Int.toString i),
1022 string "].length = &in_length",
1023 string (Int.toString i),
1024 string ";",
1025 newline]
1026 | Time =>
1027 let
1028 fun oneField dst src =
1029 box [string "in_buffer",
1030 string (Int.toString i),
1031 string ".",
1032 string dst,
1033 string " = tms.tm_",
1034 string src,
1035 string ";",
1036 newline]
1037 in
1038 box [string "({",
1039 newline,
1040 string "struct tm tms;",
1041 newline,
1042 string "if (localtime_r(&arg",
1043 string (Int.toString (i + 1)),
1044 string ", &tm) == NULL) uw_error(\"",
1045 string (ErrorMsg.spanToString loc),
1046 string ": error converting to MySQL time\");",
1047 newline,
1048 oneField "year" "year",
1049 box [string "in_buffer",
1050 string (Int.toString i),
1051 string ".month = tms.tm_mon + 1;",
1052 newline],
1053 oneField "day" "mday",
1054 oneField "hour" "hour",
1055 oneField "minute" "min",
1056 oneField "second" "sec",
1057 newline,
1058 string "in[",
1059 string (Int.toString i),
1060 string "].buffer = &in_buffer",
1061 string (Int.toString i),
1062 string ";",
1063 newline]
1064 end
1065
1066 | _ => box [string "in[",
1067 string (Int.toString i),
1068 string "].buffer = &arg",
1069 string (Int.toString (i + 1)),
1070 string ";",
1071 newline]
1072 in
1073 box [string "in[",
1074 string (Int.toString i),
1075 string "].buffer_type = ",
1076 string (p_buffer_type t),
1077 string ";",
1078 newline,
1079
1080 case t of
1081 Nullable t => box [string "in[",
1082 string (Int.toString i),
1083 string "].is_null = &in_is_null",
1084 string (Int.toString i),
1085 string ";",
1086 newline,
1087 string "if (arg",
1088 string (Int.toString (i + 1)),
1089 string " == NULL) {",
1090 newline,
1091 box [string "in_is_null",
1092 string (Int.toString i),
1093 string " = 1;",
1094 newline],
1095 string "} else {",
1096 box [case t of
1097 String => box []
1098 | _ =>
1099 box [string (p_sql_ctype t),
1100 space,
1101 string "tmp = *arg",
1102 string (Int.toString (i + 1)),
1103 string ";",
1104 newline,
1105 string (p_sql_ctype t),
1106 space,
1107 string "arg",
1108 string (Int.toString (i + 1)),
1109 string " = tmp;",
1110 newline],
1111 string "in_is_null",
1112 string (Int.toString i),
1113 string " = 0;",
1114 newline,
1115 buffers t,
1116 newline],
1117 string "}",
1118 newline]
1119
1120 | _ => buffers t,
1121 newline]
1122 end) inputs,
1123 newline,
1124
1125 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
1126 string (ErrorMsg.spanToString loc),
1127 string ": error binding parameters\");",
1128 newline,
1129
1130 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
1131 string (String.toString query),
1132 string "\""]},
1133
1134 if nested then
1135 box [string "uw_pop_cleanup(ctx);",
1136 newline]
1137 else
1138 box []]
1139
1140 fun dmlCommon {loc, dml} =
1141 box [string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"",
1142 string (ErrorMsg.spanToString loc),
1143 string ": Error executing DML: %s\\n%s\", ",
1144 dml,
1145 string ", mysql_error(conn->conn));",
1146 newline,
1147 newline]
1148
1149 fun dml loc =
1150 box [string "uw_conn *conn = uw_get_db(ctx);",
1151 newline,
1152 string "MYSQL_stmt *stmt = mysql_stmt_init(conn->conn);",
1153 newline,
1154 string "if (stmt == NULL) uw_error(ctx, \"",
1155 string (ErrorMsg.spanToString loc),
1156 string ": can't allocate temporary prepared statement\");",
1157 newline,
1158 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
1159 newline,
1160 string "if (mysql_stmt_prepare(stmt, dml, strlen(dml))) uw_error(ctx, FATAL, \"",
1161 string (ErrorMsg.spanToString loc),
1162 string ": error preparing statement: %s\\n%s\", dml, mysql_error(conn->conn));",
1163 newline,
1164 newline,
1165
1166 dmlCommon {loc = loc, dml = string "dml"},
1167
1168 string "uw_pop_cleanup(ctx);",
1169 newline]
1170
1171 fun dmlPrepared {loc, id, dml, inputs} =
1172 box [string "uw_conn *conn = uw_get_db(ctx);",
1173 newline,
1174 string "MYSQL_BIND in[",
1175 string (Int.toString (length inputs)),
1176 string "];",
1177 newline,
1178 p_list_sepi (box []) (fn i => fn t =>
1179 let
1180 fun buffers t =
1181 case t of
1182 String => box [string "unsigned long in_length",
1183 string (Int.toString i),
1184 string ";",
1185 newline]
1186 | Blob => box [string "unsigned long in_length",
1187 string (Int.toString i),
1188 string ";",
1189 newline]
1190 | Time => box [string "MYSQL_TIME in_buffer",
1191 string (Int.toString i),
1192 string ";",
1193 newline]
1194 | _ => box []
1195 in
1196 box [case t of
1197 Nullable t => box [string "my_bool in_is_null",
1198 string (Int.toString i),
1199 string ";",
1200 newline,
1201 buffers t]
1202 | _ => buffers t,
1203 newline]
1204 end) inputs,
1205 string "MYSQL_STMT *stmt = conn->p",
1206 string (Int.toString id),
1207 string ";",
1208 newline,
1209 newline,
1210
1211 string "if (stmt == NULL) {",
1212 newline,
1213 box [string "stmt = mysql_stmt_init(conn->conn);",
1214 newline,
1215 string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
1216 newline,
1217 string "if (mysql_stmt_prepare(stmt, \"",
1218 string (String.toString dml),
1219 string "\", ",
1220 string (Int.toString (size dml)),
1221 string ")) {",
1222 newline,
1223 box [string "char msg[1024];",
1224 newline,
1225 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
1226 newline,
1227 string "msg[1023] = 0;",
1228 newline,
1229 string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
1230 newline],
1231 string "}",
1232 newline,
1233 string "conn->p",
1234 string (Int.toString id),
1235 string " = stmt;",
1236 newline],
1237 string "}",
1238 newline,
978 newline, 1239 newline,
979 1240
980 string "memset(in, 0, sizeof in);", 1241 string "memset(in, 0, sizeof in);",
981 newline, 1242 newline,
982 p_list_sepi (box []) (fn i => fn t => 1243 p_list_sepi (box []) (fn i => fn t =>
1122 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"", 1383 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
1123 string (ErrorMsg.spanToString loc), 1384 string (ErrorMsg.spanToString loc),
1124 string ": error binding parameters\");", 1385 string ": error binding parameters\");",
1125 newline, 1386 newline,
1126 1387
1127 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
1128 string (String.toString query),
1129 string "\""]},
1130
1131 if nested then
1132 box [string "uw_pop_cleanup(ctx);",
1133 newline]
1134 else
1135 box []]
1136
1137 fun dmlCommon {loc, dml} =
1138 box [string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"",
1139 string (ErrorMsg.spanToString loc),
1140 string ": Error executing DML: %s\\n%s\", ",
1141 dml,
1142 string ", mysql_error(conn->conn));",
1143 newline,
1144 newline]
1145
1146 fun dml loc =
1147 box [string "uw_conn *conn = uw_get_db(ctx);",
1148 newline,
1149 string "MYSQL_stmt *stmt = mysql_stmt_init(conn->conn);",
1150 newline,
1151 string "if (stmt == NULL) uw_error(ctx, \"",
1152 string (ErrorMsg.spanToString loc),
1153 string ": can't allocate temporary prepared statement\");",
1154 newline,
1155 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
1156 newline,
1157 string "if (mysql_stmt_prepare(stmt, dml, strlen(dml))) uw_error(ctx, FATAL, \"",
1158 string (ErrorMsg.spanToString loc),
1159 string ": error preparing statement: %s\\n%s\", dml, mysql_error(conn->conn));",
1160 newline,
1161 newline,
1162
1163 dmlCommon {loc = loc, dml = string "dml"},
1164
1165 string "uw_pop_cleanup(ctx);",
1166 newline]
1167
1168 fun dmlPrepared {loc, id, dml, inputs} =
1169 box [string "uw_conn *conn = uw_get_db(ctx);",
1170 newline,
1171 string "MYSQL_BIND in[",
1172 string (Int.toString (length inputs)),
1173 string "];",
1174 newline,
1175 p_list_sepi (box []) (fn i => fn t =>
1176 let
1177 fun buffers t =
1178 case t of
1179 String => box [string "unsigned long in_length",
1180 string (Int.toString i),
1181 string ";",
1182 newline]
1183 | Blob => box [string "unsigned long in_length",
1184 string (Int.toString i),
1185 string ";",
1186 newline]
1187 | Time => box [string "MYSQL_TIME in_buffer",
1188 string (Int.toString i),
1189 string ";",
1190 newline]
1191 | _ => box []
1192 in
1193 box [case t of
1194 Nullable t => box [string "my_bool in_is_null",
1195 string (Int.toString i),
1196 string ";",
1197 newline,
1198 buffers t]
1199 | _ => buffers t,
1200 newline]
1201 end) inputs,
1202 string "MYSQL_STMT *stmt = conn->p",
1203 string (Int.toString id),
1204 string ";",
1205 newline,
1206 newline,
1207
1208 string "if (stmt == NULL) {",
1209 newline,
1210 box [string "stmt = mysql_stmt_init(conn->conn);",
1211 newline,
1212 string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
1213 newline,
1214 string "if (mysql_stmt_prepare(stmt, \"",
1215 string (String.toString dml),
1216 string "\", ",
1217 string (Int.toString (size dml)),
1218 string ")) {",
1219 newline,
1220 box [string "char msg[1024];",
1221 newline,
1222 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
1223 newline,
1224 string "msg[1023] = 0;",
1225 newline,
1226 string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
1227 newline],
1228 string "}",
1229 newline,
1230 string "conn->p",
1231 string (Int.toString id),
1232 string " = stmt;",
1233 newline],
1234 string "}",
1235 newline,
1236 newline,
1237
1238 string "memset(in, 0, sizeof in);",
1239 newline,
1240 p_list_sepi (box []) (fn i => fn t =>
1241 let
1242 fun buffers t =
1243 case t of
1244 String => box [string "in[",
1245 string (Int.toString i),
1246 string "].buffer = arg",
1247 string (Int.toString (i + 1)),
1248 string ";",
1249 newline,
1250 string "in_length",
1251 string (Int.toString i),
1252 string "= in[",
1253 string (Int.toString i),
1254 string "].buffer_length = strlen(arg",
1255 string (Int.toString (i + 1)),
1256 string ");",
1257 newline,
1258 string "in[",
1259 string (Int.toString i),
1260 string "].length = &in_length",
1261 string (Int.toString i),
1262 string ";",
1263 newline]
1264 | Blob => box [string "in[",
1265 string (Int.toString i),
1266 string "].buffer = arg",
1267 string (Int.toString (i + 1)),
1268 string ".data;",
1269 newline,
1270 string "in_length",
1271 string (Int.toString i),
1272 string "= in[",
1273 string (Int.toString i),
1274 string "].buffer_length = arg",
1275 string (Int.toString (i + 1)),
1276 string ".size;",
1277 newline,
1278 string "in[",
1279 string (Int.toString i),
1280 string "].length = &in_length",
1281 string (Int.toString i),
1282 string ";",
1283 newline]
1284 | Time =>
1285 let
1286 fun oneField dst src =
1287 box [string "in_buffer",
1288 string (Int.toString i),
1289 string ".",
1290 string dst,
1291 string " = tms.tm_",
1292 string src,
1293 string ";",
1294 newline]
1295 in
1296 box [string "({",
1297 newline,
1298 string "struct tm tms;",
1299 newline,
1300 string "if (localtime_r(&arg",
1301 string (Int.toString (i + 1)),
1302 string ", &tm) == NULL) uw_error(\"",
1303 string (ErrorMsg.spanToString loc),
1304 string ": error converting to MySQL time\");",
1305 newline,
1306 oneField "year" "year",
1307 oneField "month" "mon",
1308 oneField "day" "mday",
1309 oneField "hour" "hour",
1310 oneField "minute" "min",
1311 oneField "second" "sec",
1312 newline,
1313 string "in[",
1314 string (Int.toString i),
1315 string "].buffer = &in_buffer",
1316 string (Int.toString i),
1317 string ";",
1318 newline]
1319 end
1320
1321 | _ => box [string "in[",
1322 string (Int.toString i),
1323 string "].buffer = &arg",
1324 string (Int.toString (i + 1)),
1325 string ";",
1326 newline]
1327 in
1328 box [string "in[",
1329 string (Int.toString i),
1330 string "].buffer_type = ",
1331 string (p_buffer_type t),
1332 string ";",
1333 newline,
1334
1335 case t of
1336 Nullable t => box [string "in[",
1337 string (Int.toString i),
1338 string "].is_null = &in_is_null",
1339 string (Int.toString i),
1340 string ";",
1341 newline,
1342 string "if (arg",
1343 string (Int.toString (i + 1)),
1344 string " == NULL) {",
1345 newline,
1346 box [string "in_is_null",
1347 string (Int.toString i),
1348 string " = 1;",
1349 newline],
1350 string "} else {",
1351 box [case t of
1352 String => box []
1353 | _ =>
1354 box [string (p_sql_ctype t),
1355 space,
1356 string "tmp = *arg",
1357 string (Int.toString (i + 1)),
1358 string ";",
1359 newline,
1360 string (p_sql_ctype t),
1361 space,
1362 string "arg",
1363 string (Int.toString (i + 1)),
1364 string " = tmp;",
1365 newline],
1366 string "in_is_null",
1367 string (Int.toString i),
1368 string " = 0;",
1369 newline,
1370 buffers t,
1371 newline],
1372 string "}",
1373 newline]
1374
1375 | _ => buffers t,
1376 newline]
1377 end) inputs,
1378 newline,
1379
1380 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
1381 string (ErrorMsg.spanToString loc),
1382 string ": error binding parameters\");",
1383 newline,
1384
1385 dmlCommon {loc = loc, dml = box [string "\"", 1388 dmlCommon {loc = loc, dml = box [string "\"",
1386 string (String.toString dml), 1389 string (String.toString dml),
1387 string "\""]}] 1390 string "\""]}]
1388 1391
1389 fun nextval {loc, seqE, seqName} = 1392 fun nextval {loc, seqE, seqName} =