Ur/Web: tests/blobOpt.ur annotate

Check realloc's return code to prevent segfault on out of memory condition (Part 3)

author	Sergey Mironov <grrwlf@gmail.com>
date	Tue, 02 Sep 2014 17:37:22 +0000
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>

Mercurial > urweb