Mercurial > urweb

comparison src/postgres.sml @ 1295:929981850d9d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
'tryDml' works with Postgres
author Adam Chlipala <adam@chlipala.net>
date Tue, 07 Sep 2010 09:06:13 -0400
parents acabf3935060
children 0dec38af601c
comparison
equal deleted inserted replaced
1294:b4480a56cab7 1295:929981850d9d
1 (* Copyright (c) 2008-2009, Adam Chlipala 1 (* Copyright (c) 2008-2010, Adam Chlipala
2 * All rights reserved. 2 * All rights reserved.
3 * 3 *
4 * Redistribution and use in source and binary forms, with or without 4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met: 5 * modification, are permitted provided that the following conditions are met:
6 * 6 *
729 string "uw_error(ctx, FATAL, \"", 729 string "uw_error(ctx, FATAL, \"",
730 string (ErrorMsg.spanToString loc), 730 string (ErrorMsg.spanToString loc),
731 string ": DML failed:\\n%s\\n%s\", ", 731 string ": DML failed:\\n%s\\n%s\", ",
732 dml, 732 dml,
733 string ", PQerrorMessage(conn));"] 733 string ", PQerrorMessage(conn));"]
734 | Settings.None => string "uw_errmsg = PQerrorMessage(conn);", 734 | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
735 newline,
736 newline,
737
738 string "res = PQexec(conn, \"ROLLBACK TO s\");",
739 newline,
740 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
741 newline,
742 newline,
743
744 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
745 newline,
746 box [string "PQclear(res);",
747 newline,
748 string "uw_error(ctx, FATAL, \"",
749 string (ErrorMsg.spanToString loc),
750 string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
751 dml,
752 string ", PQerrorMessage(conn));",
753 newline,
754 string "}"],
755 newline,
756
757 string "PQclear(res);",
758 newline],
735 newline], 759 newline],
736 string "}", 760 string "}",
737 newline, 761
738 newline, 762 case mode of
739 763 Error => box [newline,
740 string "PQclear(res);", 764 newline,
741 newline] 765 string "PQclear(res);",
766 newline]
767 | None => box[string " else {",
768 newline,
769 box [string "PQclear(res);",
770 newline,
771 string "res = PQexec(conn, \"RELEASE s\");",
772 newline,
773 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
774 newline,
775 newline,
776
777 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
778 newline,
779 box [string "PQclear(res);",
780 newline,
781 string "uw_error(ctx, FATAL, \"",
782 string (ErrorMsg.spanToString loc),
783 string ": RELEASE failed:\\n%s\\n%s\", ",
784 dml,
785 string ", PQerrorMessage(conn));",
786 newline],
787 string "}",
788 newline,
789 string "PQclear(res);",
790 newline],
791 string "}",
792 newline]]
793
794 fun makeSavepoint mode =
795 case mode of
796 Error => box []
797 | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
798 newline,
799 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
800 newline,
801 newline,
802 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
803 box [newline,
804 string "PQclear(res);",
805 newline,
806 string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
807 newline],
808 string "}",
809 newline,
810 string "PQclear(res);",
811 newline,
812 newline]
742 813
743 fun dml (loc, mode) = 814 fun dml (loc, mode) =
744 box [string "PGconn *conn = uw_get_db(ctx);", 815 box [string "PGconn *conn = uw_get_db(ctx);",
745 newline, 816 newline,
746 string "PGresult *res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);", 817 string "PGresult *res;",
818 newline,
819
820 makeSavepoint mode,
821
822 string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
747 newline, 823 newline,
748 newline, 824 newline,
749 dmlCommon {loc = loc, dml = string "dml", mode = mode}] 825 dmlCommon {loc = loc, dml = string "dml", mode = mode}]
750 826
751 fun dmlPrepared {loc, id, dml, inputs, mode} = 827 fun dmlPrepared {loc, id, dml, inputs, mode} =
770 string (Int.toString (i + 1))])) 846 string (Int.toString (i + 1))]))
771 inputs, 847 inputs,
772 string " };", 848 string " };",
773 newline, 849 newline,
774 newline, 850 newline,
775 string "PGresult *res = ", 851 string "PGresult *res;",
852 newline,
853 newline,
854
855 makeSavepoint mode,
856
857 string "res = ",
776 if #persistent (Settings.currentProtocol ()) then 858 if #persistent (Settings.currentProtocol ()) then
777 box [string "PQexecPrepared(conn, \"uw", 859 box [string "PQexecPrepared(conn, \"uw",
778 string (Int.toString id), 860 string (Int.toString id),
779 string "\", ", 861 string "\", ",
780 string (Int.toString (length inputs)), 862 string (Int.toString (length inputs)),