Mercurial > urweb
comparison src/cjr_print.sml @ 868:06497beb265b
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 "}))"] |