Mercurial > urweb
diff src/postgres.sml @ 871:3ae6b655ced0
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 |
line wrap: on
line diff
--- a/src/postgres.sml Tue Jun 30 15:45:10 2009 -0400 +++ b/src/postgres.sml Tue Jun 30 15:59:41 2009 -0400 @@ -36,16 +36,198 @@ fun p_sql_type_base t = case t of - Int => "int8" - | Float => "float8" + Int => "bigint" + | Float => "double precision" | String => "text" - | Bool => "bool" - | Time => "timestamp" + | Bool => "boolean" + | Time => "timestamp without time zone" | Blob => "bytea" - | Channel => "int8" - | Client => "int4" + | Channel => "bigint" + | Client => "integer" | Nullable t => p_sql_type_base t +fun checkRel (s, xts) = + let + val sl = CharVector.map Char.toLower s + + val q = "SELECT COUNT(*) FROM information_schema.tables WHERE table_name = '" + ^ sl ^ "'" + + val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", + sl, + "' AND (", + String.concatWith " OR " + (map (fn (x, t) => + String.concat ["(column_name = 'uw_", + CharVector.map + Char.toLower (ident x), + "' AND data_type = '", + p_sql_type_base t, + "' AND is_nullable = '", + if isNotNull t then + "NO" + else + "YES", + "')"]) xts), + ")"] + + val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", + sl, + "' AND column_name LIKE 'uw_%'"] + in + box [string "res = PQexec(conn, \"", + string q, + string "\");", + newline, + newline, + string "if (res == NULL) {", + newline, + box [string "PQfinish(conn);", + newline, + string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", + newline], + string "}", + newline, + newline, + string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", + newline, + box [string "char msg[1024];", + newline, + string "strncpy(msg, PQerrorMessage(conn), 1024);", + newline, + string "msg[1023] = 0;", + newline, + string "PQclear(res);", + newline, + string "PQfinish(conn);", + newline, + string "uw_error(ctx, FATAL, \"Query failed:\\n", + string q, + string "\\n%s\", msg);", + newline], + string "}", + newline, + newline, + string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {", + newline, + box [string "PQclear(res);", + newline, + string "PQfinish(conn);", + newline, + string "uw_error(ctx, FATAL, \"Table '", + string s, + string "' does not exist.\");", + newline], + string "}", + newline, + newline, + string "PQclear(res);", + newline, + + string "res = PQexec(conn, \"", + string q', + string "\");", + newline, + newline, + string "if (res == NULL) {", + newline, + box [string "PQfinish(conn);", + newline, + string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", + newline], + string "}", + newline, + newline, + string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", + newline, + box [string "char msg[1024];", + newline, + string "strncpy(msg, PQerrorMessage(conn), 1024);", + newline, + string "msg[1023] = 0;", + newline, + string "PQclear(res);", + newline, + string "PQfinish(conn);", + newline, + string "uw_error(ctx, FATAL, \"Query failed:\\n", + string q', + string "\\n%s\", msg);", + newline], + string "}", + newline, + newline, + string "if (strcmp(PQgetvalue(res, 0, 0), \"", + string (Int.toString (length xts)), + string "\")) {", + newline, + box [string "PQclear(res);", + newline, + string "PQfinish(conn);", + newline, + string "uw_error(ctx, FATAL, \"Table '", + string s, + string "' has the wrong column types.\");", + newline], + string "}", + newline, + newline, + string "PQclear(res);", + newline, + newline, + + string "res = PQexec(conn, \"", + string q'', + string "\");", + newline, + newline, + string "if (res == NULL) {", + newline, + box [string "PQfinish(conn);", + newline, + string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", + newline], + string "}", + newline, + newline, + string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", + newline, + box [string "char msg[1024];", + newline, + string "strncpy(msg, PQerrorMessage(conn), 1024);", + newline, + string "msg[1023] = 0;", + newline, + string "PQclear(res);", + newline, + string "PQfinish(conn);", + newline, + string "uw_error(ctx, FATAL, \"Query failed:\\n", + string q'', + string "\\n%s\", msg);", + newline], + string "}", + newline, + newline, + string "if (strcmp(PQgetvalue(res, 0, 0), \"", + string (Int.toString (length xts)), + string "\")) {", + newline, + box [string "PQclear(res);", + newline, + string "PQfinish(conn);", + newline, + string "uw_error(ctx, FATAL, \"Table '", + string s, + string "' has extra columns.\");", + newline], + string "}", + newline, + newline, + string "PQclear(res);", + newline] + end + fun init {dbstring, prepared = ss, tables, sequences} = box [if #persistent (currentProtocol ()) then box [string "static void uw_db_validate(uw_context ctx) {", @@ -55,189 +237,7 @@ string "PGresult *res;", newline, newline, - p_list_sep newline - (fn (s, xts) => - let - val sl = CharVector.map Char.toLower s - - val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '" - ^ sl ^ "'" - - val q' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '", - sl, - "') AND (", - String.concatWith " OR " - (map (fn (x, t) => - String.concat ["(attname = 'uw_", - CharVector.map - Char.toLower (ident x), - "' AND atttypid = (SELECT oid FROM pg_type", - " WHERE typname = '", - p_sql_type_base t, - "') AND attnotnull = ", - if isNotNull t then - "TRUE" - else - "FALSE", - ")"]) xts), - ")"] - - val q'' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '", - sl, - "') AND attname LIKE 'uw_%'"] - in - box [string "res = PQexec(conn, \"", - string q, - string "\");", - newline, - newline, - string "if (res == NULL) {", - newline, - box [string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", - newline], - string "}", - newline, - newline, - string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", - newline, - box [string "char msg[1024];", - newline, - string "strncpy(msg, PQerrorMessage(conn), 1024);", - newline, - string "msg[1023] = 0;", - newline, - string "PQclear(res);", - newline, - string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Query failed:\\n", - string q, - string "\\n%s\", msg);", - newline], - string "}", - newline, - newline, - string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {", - newline, - box [string "PQclear(res);", - newline, - string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Table '", - string s, - string "' does not exist.\");", - newline], - string "}", - newline, - newline, - string "PQclear(res);", - newline, - - string "res = PQexec(conn, \"", - string q', - string "\");", - newline, - newline, - string "if (res == NULL) {", - newline, - box [string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", - newline], - string "}", - newline, - newline, - string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", - newline, - box [string "char msg[1024];", - newline, - string "strncpy(msg, PQerrorMessage(conn), 1024);", - newline, - string "msg[1023] = 0;", - newline, - string "PQclear(res);", - newline, - string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Query failed:\\n", - string q', - string "\\n%s\", msg);", - newline], - string "}", - newline, - newline, - string "if (strcmp(PQgetvalue(res, 0, 0), \"", - string (Int.toString (length xts)), - string "\")) {", - newline, - box [string "PQclear(res);", - newline, - string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Table '", - string s, - string "' has the wrong column types.\");", - newline], - string "}", - newline, - newline, - string "PQclear(res);", - newline, - newline, - - string "res = PQexec(conn, \"", - string q'', - string "\");", - newline, - newline, - string "if (res == NULL) {", - newline, - box [string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", - newline], - string "}", - newline, - newline, - string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", - newline, - box [string "char msg[1024];", - newline, - string "strncpy(msg, PQerrorMessage(conn), 1024);", - newline, - string "msg[1023] = 0;", - newline, - string "PQclear(res);", - newline, - string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Query failed:\\n", - string q'', - string "\\n%s\", msg);", - newline], - string "}", - newline, - newline, - string "if (strcmp(PQgetvalue(res, 0, 0), \"", - string (Int.toString (length xts)), - string "\")) {", - newline, - box [string "PQclear(res);", - newline, - string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Table '", - string s, - string "' has extra columns.\");", - newline], - string "}", - newline, - newline, - string "PQclear(res);", - newline] - end) tables, + p_list_sep newline checkRel tables, p_list_sep newline (fn s =>