Mercurial > urweb

comparison src/cjr_print.sml @ 377:78358e5df273

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Proper generation of relation names; checking that sequences exist
author Adam Chlipala <adamc@hcoop.net>
date Sun, 19 Oct 2008 12:12:59 -0400
parents 6fd102fa28f9
children 168667cdaa95
comparison
equal deleted inserted replaced
376:6fd102fa28f9 377:78358e5df273
1776 1776
1777 val pds' = map p_page ps 1777 val pds' = map p_page ps
1778 1778
1779 val tables = List.mapPartial (fn (DTable (s, xts), _) => SOME (s, xts) 1779 val tables = List.mapPartial (fn (DTable (s, xts), _) => SOME (s, xts)
1780 | _ => NONE) ds 1780 | _ => NONE) ds
1781 val sequences = List.mapPartial (fn (DSequence s, _) => SOME s
1782 | _ => NONE) ds
1781 1783
1782 val validate = 1784 val validate =
1783 box [string "static void uw_db_validate(uw_context ctx) {", 1785 box [string "static void uw_db_validate(uw_context ctx) {",
1784 newline, 1786 newline,
1785 string "PGconn *conn = uw_get_db(ctx);", 1787 string "PGconn *conn = uw_get_db(ctx);",
1788 newline, 1790 newline,
1789 newline, 1791 newline,
1790 p_list_sep newline 1792 p_list_sep newline
1791 (fn (s, xts) => 1793 (fn (s, xts) =>
1792 let 1794 let
1795 val sl = CharVector.map Char.toLower s
1796
1793 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '" 1797 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
1794 ^ s ^ "'" 1798 ^ sl ^ "'"
1795 1799
1796 val q' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '", 1800 val q' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
1797 s, 1801 sl,
1798 "') AND (", 1802 "') AND (",
1799 String.concatWith " OR " 1803 String.concatWith " OR "
1800 (map (fn (x, t) => 1804 (map (fn (x, t) =>
1801 String.concat ["(attname = 'uw_", 1805 String.concat ["(attname = 'uw_",
1802 CharVector.map 1806 CharVector.map
1806 p_sqltype' env t, 1810 p_sqltype' env t,
1807 "'))"]) xts), 1811 "'))"]) xts),
1808 ")"] 1812 ")"]
1809 1813
1810 val q'' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '", 1814 val q'' = String.concat ["SELECT COUNT(*) FROM pg_attribute WHERE attrelid = (SELECT oid FROM pg_class WHERE relname = '",
1811 s, 1815 sl,
1812 "') AND attname LIKE 'uw_%'"] 1816 "') AND attname LIKE 'uw_%'"]
1813 in 1817 in
1814 box [string "res = PQexec(conn, \"", 1818 box [string "res = PQexec(conn, \"",
1815 string q, 1819 string q,
1816 string "\");", 1820 string "\");",
1961 newline, 1965 newline,
1962 newline, 1966 newline,
1963 string "PQclear(res);", 1967 string "PQclear(res);",
1964 newline] 1968 newline]
1965 end) tables, 1969 end) tables,
1970
1971 p_list_sep newline
1972 (fn s =>
1973 let
1974 val sl = CharVector.map Char.toLower s
1975
1976 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
1977 ^ sl ^ "' AND relkind = 'S'"
1978 in
1979 box [string "res = PQexec(conn, \"",
1980 string q,
1981 string "\");",
1982 newline,
1983 newline,
1984 string "if (res == NULL) {",
1985 newline,
1986 box [string "PQfinish(conn);",
1987 newline,
1988 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
1989 newline],
1990 string "}",
1991 newline,
1992 newline,
1993 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
1994 newline,
1995 box [string "char msg[1024];",
1996 newline,
1997 string "strncpy(msg, PQerrorMessage(conn), 1024);",
1998 newline,
1999 string "msg[1023] = 0;",
2000 newline,
2001 string "PQclear(res);",
2002 newline,
2003 string "PQfinish(conn);",
2004 newline,
2005 string "uw_error(ctx, FATAL, \"Query failed:\\n",
2006 string q,
2007 string "\\n%s\", msg);",
2008 newline],
2009 string "}",
2010 newline,
2011 newline,
2012 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
2013 newline,
2014 box [string "PQclear(res);",
2015 newline,
2016 string "PQfinish(conn);",
2017 newline,
2018 string "uw_error(ctx, FATAL, \"Sequence '",
2019 string s,
2020 string "' does not exist.\");",
2021 newline],
2022 string "}",
2023 newline,
2024 newline,
2025 string "PQclear(res);",
2026 newline]
2027 end) sequences,
2028
1966 string "}"] 2029 string "}"]
1967 in 2030 in
1968 box [string "#include <stdio.h>", 2031 box [string "#include <stdio.h>",
1969 newline, 2032 newline,
1970 string "#include <stdlib.h>", 2033 string "#include <stdlib.h>",