Mercurial > urweb

comparison src/cjr_print.sml @ 868:06497beb265b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Moved dml code into Settings
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Jun 2009 16:22:17 -0400
parents e7f80d78075b
children 64ba57fa20bf
comparison
equal deleted inserted replaced
867:e7f80d78075b 868:06497beb265b
1694 end 1694 end
1695 1695
1696 | EDml {dml, prepared} => 1696 | EDml {dml, prepared} =>
1697 box [string "(uw_begin_region(ctx), ({", 1697 box [string "(uw_begin_region(ctx), ({",
1698 newline, 1698 newline,
1699 string "PGconn *conn = uw_get_db(ctx);",
1700 newline,
1701 case prepared of 1699 case prepared of
1702 NONE => box [string "char *dml = ", 1700 NONE => box [string "char *dml = ",
1703 p_exp env dml, 1701 p_exp env dml,
1704 string ";", 1702 string ";",
1705 newline] 1703 newline,
1706 | SOME _ => 1704 newline,
1705 #dml (Settings.currentDbms ()) loc]
1706 | SOME (id, dml') =>
1707 let 1707 let
1708 val ets = getPargs dml 1708 val inputs = getPargs dml
1709 in 1709 in
1710 box [p_list_sepi newline 1710 box [p_list_sepi newline
1711 (fn i => fn (e, t) => 1711 (fn i => fn (e, t) =>
1712 box [p_sql_type t, 1712 box [p_sql_type t,
1713 space, 1713 space,
1716 space, 1716 space,
1717 string "=", 1717 string "=",
1718 space, 1718 space,
1719 p_exp env e, 1719 p_exp env e,
1720 string ";"]) 1720 string ";"])
1721 ets, 1721 inputs,
1722 newline, 1722 newline,
1723 newline, 1723 newline,
1724 1724
1725 string "const int paramFormats[] = { ", 1725 #dmlPrepared (Settings.currentDbms ()) {loc = loc,
1726 p_list_sep (box [string ",", space]) 1726 id = id,
1727 (fn (_, t) => if isBlob t then string "1" else string "0") ets, 1727 dml = dml',
1728 string " };", 1728 inputs = map #2 inputs}]
1729 newline,
1730 string "const int paramLengths[] = { ",
1731 p_list_sepi (box [string ",", space])
1732 (fn i => fn (_, Blob) => string ("arg" ^ Int.toString (i + 1) ^ ".size")
1733 | (_, Nullable Blob) => string ("arg" ^ Int.toString (i + 1)
1734 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
1735 | _ => string "0") ets,
1736 string " };",
1737 newline,
1738 string "const char *paramValues[] = { ",
1739 p_list_sepi (box [string ",", space])
1740 (fn i => fn (_, t) => p_ensql t (box [string "arg",
1741 string (Int.toString (i + 1))]))
1742 ets,
1743 string " };",
1744 newline,
1745 newline]
1746 end, 1729 end,
1747 newline, 1730 newline,
1748 newline, 1731 newline,
1749 string "PGresult *res = ", 1732
1750 case prepared of
1751 NONE => string "PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);"
1752 | SOME (n, s) =>
1753 if #persistent (Settings.currentProtocol ()) then
1754 box [string "PQexecPrepared(conn, \"uw",
1755 string (Int.toString n),
1756 string "\", ",
1757 string (Int.toString (length (getPargs dml))),
1758 string ", paramValues, paramLengths, paramFormats, 0);"]
1759 else
1760 box [string "PQexecParams(conn, \"",
1761 string (String.toString s),
1762 string "\", ",
1763 string (Int.toString (length (getPargs dml))),
1764 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
1765 newline,
1766 newline,
1767
1768 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
1769 newline,
1770 newline,
1771
1772 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
1773 newline,
1774 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
1775 box [newline,
1776 string "PQclear(res);",
1777 newline,
1778 string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
1779 newline],
1780 string "}",
1781 newline,
1782 string "PQclear(res);",
1783 newline,
1784 string "uw_error(ctx, FATAL, \"",
1785 string (ErrorMsg.spanToString loc),
1786 string ": DML failed:\\n%s\\n%s\", ",
1787 case prepared of
1788 NONE => string "dml"
1789 | SOME _ => p_exp env dml,
1790 string ", PQerrorMessage(conn));",
1791 newline],
1792 string "}",
1793 newline,
1794 newline,
1795
1796 string "PQclear(res);",
1797 newline,
1798 string "uw_end_region(ctx);", 1733 string "uw_end_region(ctx);",
1799 newline, 1734 newline,
1800 string "uw_unit_v;", 1735 string "uw_unit_v;",
1801 newline, 1736 newline,
1802 string "}))"] 1737 string "}))"]