(* * Dynamic web page generation with Standard ML * Copyright (C) 2003 Adam Chlipala * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (* CGI interaction *) structure Web :> WEB = struct fun for f (r1, r2) = if r1 < r2 then let fun loop i = if i > r2 then () else (f i; loop (i+1)) in loop r1 end else let fun loop i = if i < r2 then () else (f i; loop (i-1)) in loop r1 end val params : string list StringMap.map ref = ref StringMap.empty val paramStack : string list StringMap.map list ref = ref [] fun setParam (n, v) = params := StringMap.insert (!params, n, v) fun setSingleParam (n, v) = setParam (n, [v]) fun getParam v = (case StringMap.find (!params, v) of NONE => "" | SOME [] => "" | SOME (s::_) => s) fun getMultiParam v = (case StringMap.find (!params, v) of NONE => [] | SOME l => l) fun pushParams nvs = (paramStack := (!params) :: (!paramStack); app setParam nvs) fun popParams () = (case !paramStack of [] => raise Fail "Empty params stack in popParams" | h::t => (params := h; paramStack := t)) fun withParams f nvs = (pushParams nvs; ((f ()) handle ex => (popParams (); raise ex)) before popParams ()) val text = ref ([] : string list) fun print x = text := x :: (!text) fun output () = (TextIO.print "Status: 200\nContent-type: text/html\n\n"; TextIO.print (String.concat (List.rev (!text)))) val getCgi = OS.Process.getEnv fun html s = let fun xch #"<" = "<" | xch #">" = ">" | xch #"&" = "&" | xch #"\"" = """ | xch ch = str ch in foldr op^ "" (map xch (String.explode s)) end fun htmlNl s = let fun xch #"<" = "<" | xch #">" = ">" | xch #"&" = "&" | xch #"\"" = """ | xch #"\n" = "
" | xch ch = str ch in foldr op^ "" (map xch (String.explode s)) end exception Format of string fun stoiOpt s = Int.fromString s fun stoi s = (case Int.fromString s of NONE => raise Format s | SOME i => i) fun storOpt s = Real.fromString s fun stor s = (case Real.fromString s of NONE => raise Format s | SOME r => r) fun summary () = StringMap.foldli (fn (n, vs, s) => foldl (fn (v, s) => s ^ " VALUE: " ^ v) (s ^ " NAME: " ^ n) vs) "" (!params) end