Mercurial > urweb

comparison src/mysql.sml @ 875:c50101ddf7fa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
demo/sql working with MySQL
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Jul 2009 15:42:24 -0400
parents 3c7b48040dcf
children 025806b3c014
comparison
equal deleted inserted replaced
874:3c7b48040dcf 875:c50101ddf7fa
739 newline, 739 newline,
740 p_list_sepi (box []) (fn i => fn t => 740 p_list_sepi (box []) (fn i => fn t =>
741 let 741 let
742 fun buffers t = 742 fun buffers t =
743 case t of 743 case t of
744 String => box [] 744 String => box [string "out[",
745 | Blob => box [] 745 string (Int.toString i),
746 string "].length = &length",
747 string (Int.toString i),
748 string ";",
749 newline]
750 | Blob => box [string "out[",
751 string (Int.toString i),
752 string "].length = &length",
753 string (Int.toString i),
754 string ";",
755 newline]
746 | _ => box [string "out[", 756 | _ => box [string "out[",
747 string (Int.toString i), 757 string (Int.toString i),
748 string "].buffer = &buffer", 758 string "].buffer = &buffer",
749 string (Int.toString i), 759 string (Int.toString i),
750 string ";", 760 string ";",
768 | _ => buffers t, 778 | _ => buffers t,
769 newline] 779 newline]
770 end) cols, 780 end) cols,
771 newline, 781 newline,
772 782
783 string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"",
784 string (ErrorMsg.spanToString loc),
785 string ": Error reseting statement: %s\\n%s\", ",
786 query,
787 string ", mysql_error(conn->conn));",
788 newline,
789 newline,
790
773 string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"", 791 string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"",
774 string (ErrorMsg.spanToString loc), 792 string (ErrorMsg.spanToString loc),
775 string ": Error executing query: %s\", mysql_error(conn->conn));", 793 string ": Error executing query: %s\\n%s\", ",
794 query,
795 string ", mysql_error(conn->conn));",
796 newline,
797 newline,
798
799 string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"",
800 string (ErrorMsg.spanToString loc),
801 string ": Error binding query result: %s\\n%s\", ",
802 query,
803 string ", mysql_error(conn->conn));",
776 newline, 804 newline,
777 newline, 805 newline,
778 806
779 string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"", 807 string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"",
780 string (ErrorMsg.spanToString loc), 808 string (ErrorMsg.spanToString loc),
781 string ": Error storing query result: %s\", mysql_error(conn->conn));", 809 string ": Error storing query result: %s\\n%s\", ",
782 newline, 810 query,
783 newline, 811 string ", mysql_error(conn->conn));",
784
785 string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"",
786 string (ErrorMsg.spanToString loc),
787 string ": Error binding query result: %s\", mysql_error(conn->conn));",
788 newline, 812 newline,
789 newline, 813 newline,
790 814
791 string "uw_end_region(ctx);", 815 string "uw_end_region(ctx);",
792 newline, 816 newline,
793 string "while ((r = mysql_stmt_fetch(stmt)) == 0) {", 817 string "while (1) {",
818 newline,
819 string "r = mysql_stmt_fetch(stmt);",
820 newline,
821 string "if (r != 0 && r != MYSQL_DATA_TRUNCATED) break;",
794 newline, 822 newline,
795 doCols p_getcol, 823 doCols p_getcol,
796 string "}", 824 string "}",
797 newline, 825 newline,
798 newline, 826 newline,
799 827
800 string "if (r == 1) uw_error(ctx, FATAL, \"", 828 string "if (r == 1) uw_error(ctx, FATAL, \"",
801 string (ErrorMsg.spanToString loc), 829 string (ErrorMsg.spanToString loc),
802 string ": query result fetching failed (%d): %s\", r, mysql_error(conn->conn));", 830 string ": query result fetching failed: %s\\n%s\", ",
803 newline] 831 query,
832 string ", mysql_error(conn->conn));",
833 newline,
834 newline,
835
836 string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"",
837 string (ErrorMsg.spanToString loc),
838 string ": Error reseting statement: %s\\n%s\", ",
839 query,
840 string ", mysql_error(conn->conn));",
841 newline,
842 newline]
804 843
805 fun query {loc, cols, doCols} = 844 fun query {loc, cols, doCols} =
806 box [string "uw_conn *conn = uw_get_db(ctx);", 845 box [string "uw_conn *conn = uw_get_db(ctx);",
807 newline, 846 newline,
808 string "MYSQL_stmt *stmt = mysql_stmt_init(conn->conn);", 847 string "MYSQL_stmt *stmt = mysql_stmt_init(conn->conn);",
809 newline, 848 newline,
810 string "if (stmt == NULL) uw_error(ctx, \"", 849 string "if (stmt == NULL) uw_error(ctx, FATAL, \"",
811 string (ErrorMsg.spanToString loc), 850 string (ErrorMsg.spanToString loc),
812 string ": can't allocate temporary prepared statement\");", 851 string ": can't allocate temporary prepared statement\");",
813 newline, 852 newline,
814 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);", 853 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
815 newline, 854 newline,
816 string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"", 855 string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"",
817 string (ErrorMsg.spanToString loc), 856 string (ErrorMsg.spanToString loc),
818 string ": error preparing statement: %s\", mysql_error(conn->conn));", 857 string ": error preparing statement: %s\\n%s\", query, mysql_error(conn->conn));",
819 newline, 858 newline,
820 newline,
821
822 p_list_sepi (box []) (fn i => fn t =>
823 let
824 fun buffers t =
825 case t of
826 String => box []
827 | Blob => box []
828 | _ => box [string "out[",
829 string (Int.toString i),
830 string "].buffer = &buffer",
831 string (Int.toString i),
832 string ";",
833 newline]
834 in
835 box [string "in[",
836 string (Int.toString i),
837 string "].buffer_type = ",
838 string (p_buffer_type t),
839 string ";",
840 newline,
841
842 case t of
843 Nullable t => box [string "in[",
844 string (Int.toString i),
845 string "].is_null = &is_null",
846 string (Int.toString i),
847 string ";",
848 newline,
849 buffers t]
850 | _ => buffers t,
851 newline]
852 end) cols,
853 newline, 859 newline,
854 860
855 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}, 861 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
856 862
857 string "uw_pop_cleanup(ctx);", 863 string "uw_pop_cleanup(ctx);",
858 newline] 864 newline]
859
860 fun p_ensql t e =
861 case t of
862 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
863 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
864 | String => e
865 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
866 | Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"]
867 | Blob => box [e, string ".data"]
868 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
869 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
870 | Nullable String => e
871 | Nullable t => box [string "(",
872 e,
873 string " == NULL ? NULL : ",
874 p_ensql t (box [string "(*", e, string ")"]),
875 string ")"]
876 865
877 fun queryPrepared {loc, id, query, inputs, cols, doCols} = 866 fun queryPrepared {loc, id, query, inputs, cols, doCols} =
878 box [string "uw_conn *conn = uw_get_db(ctx);", 867 box [string "uw_conn *conn = uw_get_db(ctx);",
879 newline, 868 newline,
880 string "MYSQL_BIND in[", 869 string "MYSQL_BIND in[",
1050 | _ => buffers t, 1039 | _ => buffers t,
1051 newline] 1040 newline]
1052 end) inputs, 1041 end) inputs,
1053 newline, 1042 newline,
1054 1043
1044 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
1045 string (ErrorMsg.spanToString loc),
1046 string ": error binding parameters\");",
1047 newline,
1048
1055 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", 1049 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
1056 string (String.toString query), 1050 string (String.toString query),
1057 string "\""]}] 1051 string "\""]}]
1058 1052
1059 fun dml _ = box [] 1053 fun dmlCommon {loc, dml} =
1060 fun dmlPrepared _ = box [] 1054 box [string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"",
1055 string (ErrorMsg.spanToString loc),
1056 string ": Error executing DML: %s\\n%s\", ",
1057 dml,
1058 string ", mysql_error(conn->conn));",
1059 newline,
1060 newline]
1061
1062 fun dml loc =
1063 box [string "uw_conn *conn = uw_get_db(ctx);",
1064 newline,
1065 string "MYSQL_stmt *stmt = mysql_stmt_init(conn->conn);",
1066 newline,
1067 string "if (stmt == NULL) uw_error(ctx, \"",
1068 string (ErrorMsg.spanToString loc),
1069 string ": can't allocate temporary prepared statement\");",
1070 newline,
1071 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
1072 newline,
1073 string "if (mysql_stmt_prepare(stmt, dml, strlen(dml))) uw_error(ctx, FATAL, \"",
1074 string (ErrorMsg.spanToString loc),
1075 string ": error preparing statement: %s\\n%s\", dml, mysql_error(conn->conn));",
1076 newline,
1077 newline,
1078
1079 dmlCommon {loc = loc, dml = string "dml"},
1080
1081 string "uw_pop_cleanup(ctx);",
1082 newline]
1083
1084 fun dmlPrepared {loc, id, dml, inputs} =
1085 box [string "uw_conn *conn = uw_get_db(ctx);",
1086 newline,
1087 string "MYSQL_BIND in[",
1088 string (Int.toString (length inputs)),
1089 string "];",
1090 newline,
1091 p_list_sepi (box []) (fn i => fn t =>
1092 let
1093 fun buffers t =
1094 case t of
1095 String => box [string "unsigned long in_length",
1096 string (Int.toString i),
1097 string ";",
1098 newline]
1099 | Blob => box [string "unsigned long in_length",
1100 string (Int.toString i),
1101 string ";",
1102 newline]
1103 | Time => box [string (p_sql_ctype t),
1104 space,
1105 string "in_buffer",
1106 string (Int.toString i),
1107 string ";",
1108 newline]
1109 | _ => box []
1110 in
1111 box [case t of
1112 Nullable t => box [string "my_bool in_is_null",
1113 string (Int.toString i),
1114 string ";",
1115 newline,
1116 buffers t]
1117 | _ => buffers t,
1118 newline]
1119 end) inputs,
1120 string "MYSQL_STMT *stmt = conn->p",
1121 string (Int.toString id),
1122 string ";",
1123 newline,
1124 newline,
1125
1126 string "memset(in, 0, sizeof in);",
1127 newline,
1128 p_list_sepi (box []) (fn i => fn t =>
1129 let
1130 fun buffers t =
1131 case t of
1132 String => box [string "in[",
1133 string (Int.toString i),
1134 string "].buffer = arg",
1135 string (Int.toString (i + 1)),
1136 string ";",
1137 newline,
1138 string "in_length",
1139 string (Int.toString i),
1140 string "= in[",
1141 string (Int.toString i),
1142 string "].buffer_length = strlen(arg",
1143 string (Int.toString (i + 1)),
1144 string ");",
1145 newline,
1146 string "in[",
1147 string (Int.toString i),
1148 string "].length = &in_length",
1149 string (Int.toString i),
1150 string ";",
1151 newline]
1152 | Blob => box [string "in[",
1153 string (Int.toString i),
1154 string "].buffer = arg",
1155 string (Int.toString (i + 1)),
1156 string ".data;",
1157 newline,
1158 string "in_length",
1159 string (Int.toString i),
1160 string "= in[",
1161 string (Int.toString i),
1162 string "].buffer_length = arg",
1163 string (Int.toString (i + 1)),
1164 string ".size;",
1165 newline,
1166 string "in[",
1167 string (Int.toString i),
1168 string "].length = &in_length",
1169 string (Int.toString i),
1170 string ";",
1171 newline]
1172 | Time =>
1173 let
1174 fun oneField dst src =
1175 box [string "in_buffer",
1176 string (Int.toString i),
1177 string ".",
1178 string dst,
1179 string " = tms.tm_",
1180 string src,
1181 string ";",
1182 newline]
1183 in
1184 box [string "({",
1185 newline,
1186 string "struct tm tms;",
1187 newline,
1188 string "if (localtime_r(&arg",
1189 string (Int.toString (i + 1)),
1190 string ", &tm) == NULL) uw_error(\"",
1191 string (ErrorMsg.spanToString loc),
1192 string ": error converting to MySQL time\");",
1193 newline,
1194 oneField "year" "year",
1195 oneField "month" "mon",
1196 oneField "day" "mday",
1197 oneField "hour" "hour",
1198 oneField "minute" "min",
1199 oneField "second" "sec",
1200 newline,
1201 string "in[",
1202 string (Int.toString i),
1203 string "].buffer = &in_buffer",
1204 string (Int.toString i),
1205 string ";",
1206 newline]
1207 end
1208
1209 | _ => box [string "in[",
1210 string (Int.toString i),
1211 string "].buffer = &arg",
1212 string (Int.toString (i + 1)),
1213 string ";",
1214 newline]
1215 in
1216 box [string "in[",
1217 string (Int.toString i),
1218 string "].buffer_type = ",
1219 string (p_buffer_type t),
1220 string ";",
1221 newline,
1222
1223 case t of
1224 Nullable t => box [string "in[",
1225 string (Int.toString i),
1226 string "].is_null = &in_is_null",
1227 string (Int.toString i),
1228 string ";",
1229 newline,
1230 string "if (arg",
1231 string (Int.toString (i + 1)),
1232 string " == NULL) {",
1233 newline,
1234 box [string "in_is_null",
1235 string (Int.toString i),
1236 string " = 1;",
1237 newline],
1238 string "} else {",
1239 box [case t of
1240 String => box []
1241 | _ =>
1242 box [string (p_sql_ctype t),
1243 space,
1244 string "arg",
1245 string (Int.toString (i + 1)),
1246 string " = *arg",
1247 string (Int.toString (i + 1)),
1248 string ";",
1249 newline],
1250 string "in_is_null",
1251 string (Int.toString i),
1252 string " = 0;",
1253 newline,
1254 buffers t,
1255 newline]]
1256
1257 | _ => buffers t,
1258 newline]
1259 end) inputs,
1260 newline,
1261
1262 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
1263 string (ErrorMsg.spanToString loc),
1264 string ": error binding parameters\");",
1265 newline,
1266
1267 dmlCommon {loc = loc, dml = box [string "\"",
1268 string (String.toString dml),
1269 string "\""]}]
1270
1061 fun nextval _ = box [] 1271 fun nextval _ = box []
1062 fun nextvalPrepared _ = box [] 1272 fun nextvalPrepared _ = box []
1063 1273
1064 fun sqlifyString s = "CAST('" ^ String.translate (fn #"'" => "\\'" 1274 fun sqlifyString s = "CAST('" ^ String.translate (fn #"'" => "\\'"
1065 | #"\\" => "\\\\" 1275 | #"\\" => "\\\\"