Mercurial > urweb
changeset 743:cd67c3a942e3
Handling nullable blobs
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 26 Apr 2009 10:53:36 -0400 |
| parents | 43553c93dd8c |
| children | 1ef3c1ef617d |
| files | src/cjr_print.sml tests/blobOpt.ur tests/blobOpt.urp tests/blobOpt.urs |
| diffstat | 4 files changed, 56 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjr_print.sml Sun Apr 26 10:45:59 2009 -0400 +++ b/src/cjr_print.sml Sun Apr 26 10:53:36 2009 -0400 @@ -392,7 +392,7 @@ "uw_" ^ ident m ^ "_" ^ ident con, "uw_" ^ ident con) -fun p_unsql wontLeakStrings env (tAll as (t, loc)) e = +fun p_unsql wontLeakStrings env (tAll as (t, loc)) e eLen = case t of TFfi ("Basis", "int") => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"] | TFfi ("Basis", "float") => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"] @@ -403,6 +403,11 @@ box [string "uw_strdup(ctx, ", e, string ")"] | TFfi ("Basis", "bool") => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"] | TFfi ("Basis", "time") => box [string "uw_Basis_stringToTime_error(ctx, ", e, string ")"] + | TFfi ("Basis", "blob") => box [string "uw_Basis_stringToBlob_error(ctx, ", + e, + string ", ", + eLen, + string ")"] | TFfi ("Basis", "channel") => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"] | TFfi ("Basis", "client") => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"] @@ -434,18 +439,14 @@ newline, string "})"], string ")"] - - | TFfi ("Basis", "blob") => box [string "uw_Basis_stringToBlob_error(ctx, PQgetvalue(res, i, ", - string (Int.toString i), - string "), PQgetlength(res, i, ", - string (Int.toString i), - string "))"] - | _ => p_unsql wontLeakStrings env tAll (box [string "PQgetvalue(res, i, ", string (Int.toString i), string ")"]) + (box [string "PQgetlength(res, i, ", + string (Int.toString i), + string ")"]) datatype sql_type = Int @@ -526,7 +527,7 @@ | Nullable t => box [string "(", e, string " == NULL ? NULL : ", - p_ensql t (box [string "*", e]), + p_ensql t (box [string "(*", e, string ")"]), string ")"] fun notLeaky env allowHeapAllocated = @@ -1821,7 +1822,8 @@ string "n = ", p_unsql true env (TFfi ("Basis", "int"), loc) - (string "PQgetvalue(res, 0, 0)"), + (string "PQgetvalue(res, 0, 0)") + (box []), string ";", newline, string "PQclear(res);",
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/blobOpt.ur Sun Apr 26 10:53:36 2009 -0400 @@ -0,0 +1,38 @@ +sequence s +table t : { Id : int, Data : option blob, Typ : string } + +fun view id = + r <- oneRow (SELECT t.Data, t.Typ FROM t WHERE t.Id = {[id]}); + case r.T.Data of + None => return <xml>This one's empty.</xml> + | Some data => returnBlob data (blessMime r.T.Typ) + +fun save r = + id <- nextval s; + dml (INSERT INTO t (Id, Data, Typ) + VALUES ({[id]}, {[Some (fileData r.Data)]}, {[fileMimeType r.Data]})); + main () + +and saveEmpty () = + id <- nextval s; + dml (INSERT INTO t (Id, Data, Typ) + VALUES ({[id]}, {[None]}, "bogus")); + main () + +and main () = + ls <- queryX (SELECT t.Id FROM t) + (fn r => <xml><li><a link={view r.T.Id}>{[r.T.Id]}</a></li></xml>); + return <xml><body> + {ls} + + <br/> + + <form> + <upload{#Data}/> + <submit action={save}/> + </form> + + <form> + <submit action={saveEmpty}/> + </form> + </body></xml>