summaryrefslogtreecommitdiff
path: root/src/postgres.sml
diff options
context:
space:
mode:
Diffstat (limited to 'src/postgres.sml')
-rw-r--r--src/postgres.sml378
1 files changed, 189 insertions, 189 deletions
diff --git a/src/postgres.sml b/src/postgres.sml
index 1fdda8ff..5ebda223 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -36,16 +36,198 @@ val ident = String.translate (fn #"'" => "PRIME"
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 @@ fun init {dbstring, prepared = ss, tables, sequences} =
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 =>
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 11:57:06 +0000