Mercurial > urweb
annotate tests/blobOpt.ur @ 1605:48eed6cf2be7
Fix bug in previous change
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sun, 20 Nov 2011 20:46:28 -0500 |
parents | cd67c3a942e3 |
children |
rev | line source |
---|---|
adamc@743 | 1 sequence s |
adamc@743 | 2 table t : { Id : int, Data : option blob, Typ : string } |
adamc@743 | 3 |
adamc@743 | 4 fun view id = |
adamc@743 | 5 r <- oneRow (SELECT t.Data, t.Typ FROM t WHERE t.Id = {[id]}); |
adamc@743 | 6 case r.T.Data of |
adamc@743 | 7 None => return <xml>This one's empty.</xml> |
adamc@743 | 8 | Some data => returnBlob data (blessMime r.T.Typ) |
adamc@743 | 9 |
adamc@743 | 10 fun save r = |
adamc@743 | 11 id <- nextval s; |
adamc@743 | 12 dml (INSERT INTO t (Id, Data, Typ) |
adamc@743 | 13 VALUES ({[id]}, {[Some (fileData r.Data)]}, {[fileMimeType r.Data]})); |
adamc@743 | 14 main () |
adamc@743 | 15 |
adamc@743 | 16 and saveEmpty () = |
adamc@743 | 17 id <- nextval s; |
adamc@743 | 18 dml (INSERT INTO t (Id, Data, Typ) |
adamc@743 | 19 VALUES ({[id]}, {[None]}, "bogus")); |
adamc@743 | 20 main () |
adamc@743 | 21 |
adamc@743 | 22 and main () = |
adamc@743 | 23 ls <- queryX (SELECT t.Id FROM t) |
adamc@743 | 24 (fn r => <xml><li><a link={view r.T.Id}>{[r.T.Id]}</a></li></xml>); |
adamc@743 | 25 return <xml><body> |
adamc@743 | 26 {ls} |
adamc@743 | 27 |
adamc@743 | 28 <br/> |
adamc@743 | 29 |
adamc@743 | 30 <form> |
adamc@743 | 31 <upload{#Data}/> |
adamc@743 | 32 <submit action={save}/> |
adamc@743 | 33 </form> |
adamc@743 | 34 |
adamc@743 | 35 <form> |
adamc@743 | 36 <submit action={saveEmpty}/> |
adamc@743 | 37 </form> |
adamc@743 | 38 </body></xml> |