Mercurial > urweb

comparison src/postgres.sml @ 871:3ae6b655ced0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Switch to Information Schema from Postgres catalog
author Adam Chlipala <adamc@hcoop.net>
date Tue, 30 Jun 2009 15:59:41 -0400
parents 7fa9a37a34b3
children 9654bce27cff
comparison
equal deleted inserted replaced
870:7fa9a37a34b3 871:3ae6b655ced0
34 val ident = String.translate (fn #"'" => "PRIME" 34 val ident = String.translate (fn #"'" => "PRIME"
35 | ch => str ch) 35 | ch => str ch)
36 36
37 fun p_sql_type_base t = 37 fun p_sql_type_base t =
38 case t of 38 case t of
39 Int => "int8" 39 Int => "bigint"
40 | Float => "float8" 40 | Float => "double precision"
41 | String => "text" 41 | String => "text"
42 | Bool => "bool" 42 | Bool => "boolean"
43 | Time => "timestamp" 43 | Time => "timestamp without time zone"
44 | Blob => "bytea" 44 | Blob => "bytea"
45 | Channel => "int8" 45 | Channel => "bigint"
46 | Client => "int4" 46 | Client => "integer"
47 | Nullable t => p_sql_type_base t 47 | Nullable t => p_sql_type_base t
48
49 fun checkRel (s, xts) =
50 let
51 val sl = CharVector.map Char.toLower s
52
53 val q = "SELECT COUNT(*) FROM information_schema.tables WHERE table_name = '"
54 ^ sl ^ "'"
55
56 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
57 sl,
58 "' AND (",
59 String.concatWith " OR "
60 (map (fn (x, t) =>
61 String.concat ["(column_name = 'uw_",
62 CharVector.map
63 Char.toLower (ident x),
64 "' AND data_type = '",
65 p_sql_type_base t,
66 "' AND is_nullable = '",
67 if isNotNull t then
68 "NO"
69 else
70 "YES",
71 "')"]) xts),
72 ")"]
73
74 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
75 sl,
76 "' AND column_name LIKE 'uw_%'"]
77 in
78 box [string "res = PQexec(conn, \"",
79 string q,
80 string "\");",
81 newline,
82 newline,
83 string "if (res == NULL) {",
84 newline,
85 box [string "PQfinish(conn);",
86 newline,
87 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
88 newline],
89 string "}",
90 newline,
91 newline,
92 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
93 newline,
94 box [string "char msg[1024];",
95 newline,
96 string "strncpy(msg, PQerrorMessage(conn), 1024);",
97 newline,
98 string "msg[1023] = 0;",
99 newline,
100 string "PQclear(res);",
101 newline,
102 string "PQfinish(conn);",
103 newline,
104 string "uw_error(ctx, FATAL, \"Query failed:\\n",
105 string q,
106 string "\\n%s\", msg);",
107 newline],
108 string "}",
109 newline,
110 newline,
111 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
112 newline,
113 box [string "PQclear(res);",
114 newline,
115 string "PQfinish(conn);",
116 newline,
117 string "uw_error(ctx, FATAL, \"Table '",
118 string s,
119 string "' does not exist.\");",
120 newline],
121 string "}",
122 newline,
123 newline,
124 string "PQclear(res);",
125 newline,
126
127 string "res = PQexec(conn, \"",
128 string q',
129 string "\");",
130 newline,
131 newline,
132 string "if (res == NULL) {",
133 newline,
134 box [string "PQfinish(conn);",
135 newline,
136 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
137 newline],
138 string "}",
139 newline,
140 newline,
141 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
142 newline,
143 box [string "char msg[1024];",
144 newline,
145 string "strncpy(msg, PQerrorMessage(conn), 1024);",
146 newline,
147 string "msg[1023] = 0;",
148 newline,
149 string "PQclear(res);",
150 newline,
151 string "PQfinish(conn);",
152 newline,
153 string "uw_error(ctx, FATAL, \"Query failed:\\n",
154 string q',
155 string "\\n%s\", msg);",
156 newline],
157 string "}",
158 newline,
159 newline,
160 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
161 string (Int.toString (length xts)),
162 string "\")) {",
163 newline,
164 box [string "PQclear(res);",
165 newline,
166 string "PQfinish(conn);",
167 newline,
168 string "uw_error(ctx, FATAL, \"Table '",
169 string s,
170 string "' has the wrong column types.\");",
171 newline],
172 string "}",
173 newline,
174 newline,
175 string "PQclear(res);",
176 newline,
177 newline,
178
179 string "res = PQexec(conn, \"",
180 string q'',
181 string "\");",
182 newline,
183 newline,
184 string "if (res == NULL) {",
185 newline,
186 box [string "PQfinish(conn);",
187 newline,
188 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
189 newline],
190 string "}",
191 newline,
192 newline,
193 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
194 newline,
195 box [string "char msg[1024];",
196 newline,
197 string "strncpy(msg, PQerrorMessage(conn), 1024);",
198 newline,
199 string "msg[1023] = 0;",
200 newline,
201 string "PQclear(res);",
202 newline,
203 string "PQfinish(conn);",
204 newline,
205 string "uw_error(ctx, FATAL, \"Query failed:\\n",
206 string q'',
207 string "\\n%s\", msg);",
208 newline],
209 string "}",
210 newline,
211 newline,
212 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
213 string (Int.toString (length xts)),
214 string "\")) {",
215 newline,
216 box [string "PQclear(res);",
217 newline,
218 string "PQfinish(conn);",
219 newline,
220 string "uw_error(ctx, FATAL, \"Table '",
221 string s,
222 string "' has extra columns.\");",
223 newline],
224 string "}",
225 newline,
226 newline,
227 string "PQclear(res);",
228 newline]
229 end
48 230
49 fun init {dbstring, prepared = ss, tables, sequences} = 231 fun init {dbstring, prepared = ss, tables, sequences} =
50 box [if #persistent (currentProtocol ()) then 232 box [if #persistent (currentProtocol ()) then
51 box [string "static void uw_db_validate(uw_context ctx) {", 233 box [string "static void uw_db_validate(uw_context ctx) {",
52 newline, 234 newline,
53 string "PGconn *conn = uw_get_db(ctx);", 235 string "PGconn *conn = uw_get_db(ctx);",
54 newline, 236 newline,
55 string "PGresult *res;", 237 string "PGresult *res;",
56 newline, 238 newline,
57 newline, 239 newline,
58 p_list_sep newline 240 p_list_sep newline checkRel tables,
59 (fn (s, xts) =>
60 let
61 val sl = CharVector.map Char.toLower s
62
63 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
64 ^ sl ^ "'"
65
66 val q' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
67 sl,
68 "') AND (",
69 String.concatWith " OR "
70 (map (fn (x, t) =>
71 String.concat ["(attname = 'uw_",
72 CharVector.map
73 Char.toLower (ident x),
74 "' AND atttypid = (SELECT oid FROM pg_type",
75 " WHERE typname = '",
76 p_sql_type_base t,
77 "') AND attnotnull = ",
78 if isNotNull t then
79 "TRUE"
80 else
81 "FALSE",
82 ")"]) xts),
83 ")"]
84
85 val q'' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
86 sl,
87 "') AND attname LIKE 'uw_%'"]
88 in
89 box [string "res = PQexec(conn, \"",
90 string q,
91 string "\");",
92 newline,
93 newline,
94 string "if (res == NULL) {",
95 newline,
96 box [string "PQfinish(conn);",
97 newline,
98 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
99 newline],
100 string "}",
101 newline,
102 newline,
103 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
104 newline,
105 box [string "char msg[1024];",
106 newline,
107 string "strncpy(msg, PQerrorMessage(conn), 1024);",
108 newline,
109 string "msg[1023] = 0;",
110 newline,
111 string "PQclear(res);",
112 newline,
113 string "PQfinish(conn);",
114 newline,
115 string "uw_error(ctx, FATAL, \"Query failed:\\n",
116 string q,
117 string "\\n%s\", msg);",
118 newline],
119 string "}",
120 newline,
121 newline,
122 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
123 newline,
124 box [string "PQclear(res);",
125 newline,
126 string "PQfinish(conn);",
127 newline,
128 string "uw_error(ctx, FATAL, \"Table '",
129 string s,
130 string "' does not exist.\");",
131 newline],
132 string "}",
133 newline,
134 newline,
135 string "PQclear(res);",
136 newline,
137
138 string "res = PQexec(conn, \"",
139 string q',
140 string "\");",
141 newline,
142 newline,
143 string "if (res == NULL) {",
144 newline,
145 box [string "PQfinish(conn);",
146 newline,
147 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
148 newline],
149 string "}",
150 newline,
151 newline,
152 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
153 newline,
154 box [string "char msg[1024];",
155 newline,
156 string "strncpy(msg, PQerrorMessage(conn), 1024);",
157 newline,
158 string "msg[1023] = 0;",
159 newline,
160 string "PQclear(res);",
161 newline,
162 string "PQfinish(conn);",
163 newline,
164 string "uw_error(ctx, FATAL, \"Query failed:\\n",
165 string q',
166 string "\\n%s\", msg);",
167 newline],
168 string "}",
169 newline,
170 newline,
171 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
172 string (Int.toString (length xts)),
173 string "\")) {",
174 newline,
175 box [string "PQclear(res);",
176 newline,
177 string "PQfinish(conn);",
178 newline,
179 string "uw_error(ctx, FATAL, \"Table '",
180 string s,
181 string "' has the wrong column types.\");",
182 newline],
183 string "}",
184 newline,
185 newline,
186 string "PQclear(res);",
187 newline,
188 newline,
189
190 string "res = PQexec(conn, \"",
191 string q'',
192 string "\");",
193 newline,
194 newline,
195 string "if (res == NULL) {",
196 newline,
197 box [string "PQfinish(conn);",
198 newline,
199 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
200 newline],
201 string "}",
202 newline,
203 newline,
204 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
205 newline,
206 box [string "char msg[1024];",
207 newline,
208 string "strncpy(msg, PQerrorMessage(conn), 1024);",
209 newline,
210 string "msg[1023] = 0;",
211 newline,
212 string "PQclear(res);",
213 newline,
214 string "PQfinish(conn);",
215 newline,
216 string "uw_error(ctx, FATAL, \"Query failed:\\n",
217 string q'',
218 string "\\n%s\", msg);",
219 newline],
220 string "}",
221 newline,
222 newline,
223 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
224 string (Int.toString (length xts)),
225 string "\")) {",
226 newline,
227 box [string "PQclear(res);",
228 newline,
229 string "PQfinish(conn);",
230 newline,
231 string "uw_error(ctx, FATAL, \"Table '",
232 string s,
233 string "' has extra columns.\");",
234 newline],
235 string "}",
236 newline,
237 newline,
238 string "PQclear(res);",
239 newline]
240 end) tables,
241 241
242 p_list_sep newline 242 p_list_sep newline
243 (fn s => 243 (fn s =>
244 let 244 let
245 val sl = CharVector.map Char.toLower s 245 val sl = CharVector.map Char.toLower s