Mercurial > urweb

comparison src/cjr_print.sml @ 869:64ba57fa20bf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Moved nextval code into Settings
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Jun 2009 16:41:10 -0400
parents 06497beb265b
children 7fa9a37a34b3
comparison
equal deleted inserted replaced
868:06497beb265b 869:64ba57fa20bf
1749 end 1749 end
1750 in 1750 in
1751 box [string "(uw_begin_region(ctx), ", 1751 box [string "(uw_begin_region(ctx), ",
1752 string "({", 1752 string "({",
1753 newline, 1753 newline,
1754 string "PGconn *conn = uw_get_db(ctx);", 1754 string "uw_Basis_int n;",
1755 newline, 1755 newline,
1756
1756 case prepared of 1757 case prepared of
1757 NONE => box [string "char *query = ", 1758 NONE => box [string "char *query = ",
1758 p_exp env query, 1759 p_exp env query,
1759 string ";", 1760 string ";",
1760 newline] 1761 newline,
1761 | SOME _ => 1762 newline,
1762 box [], 1763
1763 newline, 1764 #nextval (Settings.currentDbms ()) loc]
1764 string "PGresult *res = ", 1765 | SOME (id, query) => #nextvalPrepared (Settings.currentDbms ()) {loc = loc,
1765 case prepared of 1766 id = id,
1766 NONE => string "PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);" 1767 query = query},
1767 | SOME (n, s) =>
1768 if #persistent (Settings.currentProtocol ()) then
1769 box [string "PQexecPrepared(conn, \"uw",
1770 string (Int.toString n),
1771 string "\", 0, NULL, NULL, NULL, 0);"]
1772 else
1773 box [string "PQexecParams(conn, \"uw",
1774 string (Int.toString n),
1775 string "\", 0, NULL, NULL, NULL, NULL, 0);"],
1776 newline,
1777 string "uw_Basis_int n;",
1778 newline, 1768 newline,
1779 newline, 1769 newline,
1780 1770
1781 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
1782 newline,
1783 newline,
1784
1785 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
1786 newline,
1787 box [string "PQclear(res);",
1788 newline,
1789 string "uw_error(ctx, FATAL, \"",
1790 string (ErrorMsg.spanToString loc),
1791 string ": Query failed:\\n%s\\n%s\", ",
1792 case prepared of
1793 NONE => string "query"
1794 | SOME _ => p_exp env query,
1795 string ", PQerrorMessage(conn));",
1796 newline],
1797 string "}",
1798 newline,
1799 newline,
1800
1801 string "uw_end_region(ctx);",
1802 newline,
1803 string "n = PQntuples(res);",
1804 newline,
1805 string "if (n != 1) {",
1806 newline,
1807 box [string "PQclear(res);",
1808 newline,
1809 string "uw_error(ctx, FATAL, \"",
1810 string (ErrorMsg.spanToString loc),
1811 string ": Wrong number of result rows:\\n%s\\n%s\", ",
1812 case prepared of
1813 NONE => string "query"
1814 | SOME _ => p_exp env query,
1815 string ", PQerrorMessage(conn));",
1816 newline],
1817 string "}",
1818 newline,
1819 newline,
1820
1821 string "n = ",
1822 p_unsql true env (TFfi ("Basis", "int"), loc)
1823 (string "PQgetvalue(res, 0, 0)")
1824 (box []),
1825 string ";",
1826 newline,
1827 string "PQclear(res);",
1828 newline,
1829 string "n;", 1771 string "n;",
1830 newline, 1772 newline,
1831 string "}))"] 1773 string "}))"]
1832 end 1774 end
1833 1775