From 7b8746ef53b3513759395de248eda479f107154a Mon Sep 17 00:00:00 2001 From: adamch Date: Tue, 26 Apr 2005 17:58:57 +0000 Subject: [PATCH] Static member pages and location summary --- static/gen.sml | 215 +++++++++++++++++++++++++++++++++++++++++++++- static/sources.cm | 2 + 2 files changed, 216 insertions(+), 1 deletion(-) diff --git a/static/gen.sml b/static/gen.sml index 6b82758..2310ca3 100644 --- a/static/gen.sml +++ b/static/gen.sml @@ -3,6 +3,13 @@ struct structure C = PgClient +structure IntKey = struct + type ord_key = int + val compare = Int.compare +end + +structure NM = BinaryMapFn(IntKey) + val outputDir = "/var/www/home/html/static/" fun generate () = @@ -56,13 +63,219 @@ fun generate () = footer outf; TextIO.closeOut outf end + + fun genMemberPages () = + let + fun doOne [id, name, rname, joined, usr] = + let + val id = C.intFromSql id + val name = C.stringFromSql name + val rname = C.stringFromSql rname + val joined = C.timestampFromSql joined + val anon = C.isNull usr + in + if anon then + () + else + let + val outf = TextIO.openOut (String.concat [outputDir, "member/", name, ".html"]) + + val _ = header (outf, "Hcoop member: " ^ name) + val _ = TextIO.output (outf, "\n\n\n\n\n\n")) + + fun doLink [url, title, descr] = (C.stringFromSql url, C.stringFromSql title, C.stringFromSql descr) + | doLink _ = raise Fail "Bad link row" + + val links = C.map db doLink (String.concat ["SELECT url, title, descr FROM Link WHERE usr = ", + Int.toString id, + " ORDER BY title"]) + + fun appLink (url, title, descr) = + (TextIO.output (outf, "\n")) + + val _ = case links of + [] => () + | _ => + (TextIO.output (outf, "\n\n\n"); + app appLink links) + + fun doContact [v, name, url, urlPrefix, urlPostfix] = + (C.stringFromSql v, C.stringFromSql name, + if C.boolFromSql url then SOME (C.stringFromSql urlPrefix, C.stringFromSql urlPostfix) else NONE) + | doContact _ = raise Fail "Bad contact row" + + val contacts = C.map db doContact (String.concat ["SELECT v, name, url, urlPrefix, urlPostfix", + " FROM Contact JOIN ContactKind ON knd = ContactKind.id", + " WHERE priv = 0", + " AND usr = ", + Int.toString id, + " ORDER BY name, v"]) + + fun appContact (v, name, url) = + let + val link = + case url of + SOME (pre, post) => String.concat ["", Web.html v, ""] + | NONE => v + in + TextIO.output (outf, "\n\n") + end + + val _ = case contacts of + [] => () + | _ => + (TextIO.output (outf, "\n\n\n"); + app appContact contacts) + in + TextIO.output (outf, "
Member: ") + val _ = TextIO.output (outf, name) + val _ = TextIO.output (outf, "
Name: ") + val _ = TextIO.output (outf, rname) + val _ = TextIO.output (outf, "
Joined: ") + val _ = TextIO.output (outf, Date.toString (Date.fromTimeLocal joined)) + + fun doLocation [id] = C.intFromSql id + | doLocation _ = raise Fail "Bad location row" + + val locations = C.map db doLocation (String.concat ["SELECT id FROM Location JOIN Lives ON loc = id AND usr = ", + Int.toString id]) + + fun printLocation id = + let + val (name, parent) = + case C.oneRow db ("SELECT name, parent FROM Location WHERE id = " ^ Int.toString id) of + [name, parent] => (C.stringFromSql name, if C.isNull parent then NONE else SOME (C.intFromSql parent)) + | _ => raise Fail "Bad printLocation row" + in + case parent of + NONE => () + | SOME parent => (printLocation parent; + TextIO.output (outf, " : ")); + TextIO.output (outf, name) + end + + val first = ref true + + fun appLocation id = + (if !first then + first := false + else + TextIO.output (outf, ", "); + printLocation id) + + val _ = case locations of + [] => () + | _ => + (TextIO.output (outf, "
Locations: "); + app appLocation locations; + TextIO.output (outf, "
"); + TextIO.output (outf, Web.html title); + TextIO.output (outf, ""); + if descr <> "" then + TextIO.output (outf, ": ") + else + (); + TextIO.output (outf, Web.html descr); + TextIO.output (outf, "
Hosted sites
"); + TextIO.output (outf, Web.html name); + TextIO.output (outf, ":"); + TextIO.output (outf, link); + TextIO.output (outf, "
Contact information
\n"); + footer outf; + TextIO.closeOut outf + end + end + | doOne _ = raise Fail "Bad member row" + in + C.app db doOne "SELECT id, name, rname, joined, usr FROM WebUser LEFT OUTER JOIN DirectoryPref ON usr = id" + end + + fun genLocations () = + let + val outf = TextIO.openOut (outputDir ^ "locs.html") + + val _ = header (outf, "Where members live") + + fun countResidents () = + let + fun mkLivesRow [loc, usr] = + {loc = C.intFromSql loc, usr = C.intFromSql usr} + | mkLivesRow row = raise Fail "Bad lives row" + + fun folder (row, count) = + let + fun addToParents (id, count) = + let + val count = NM.insert (count, id, (case NM.find (count, id) of + NONE => 1 + | SOME n => n+1)) + in + case C.oneRow db ("SELECT parent FROM Location WHERE id = " ^ C.intToSql id) of + [p] => if C.isNull p then + count + else + addToParents (C.intFromSql p, count) + | r => raise Fail "Bad addToParents row" + end + + val lives = mkLivesRow row + in + addToParents (#loc lives, count) + end + in + C.fold db folder NM.empty "SELECT loc, usr FROM Lives" + end + + val res = countResidents () + + fun locationTree root = + let + fun doOne [id, name] = + let + val id = C.intFromSql id + val name = C.stringFromSql name + in + TextIO.output (outf, "
  • "); + TextIO.output (outf, Web.html name); + case NM.find (res, id) of + NONE => () + | SOME n => (TextIO.output (outf, " ("); + TextIO.output (outf, Int.toString n); + TextIO.output (outf, ")")); + TextIO.output (outf, "
    • \n\n") + end + | doOne _ = raise Fail "Bad locationTree row" + in + C.app db doOne (String.concat ["SELECT id, name FROM Location WHERE parent ", + (case root of NONE => "IS NULL" | SOME p => "= " ^ Int.toString p), + " ORDER BY name"]) + end + in + locationTree NONE; + footer outf; + TextIO.closeOut outf + end in genMemberList (); + genMemberPages (); + genLocations (); OS.Process.success end fun main _ = (generate ()) - handle ex => (print "Exception!\n"; + handle + C.Sql s => (print "SQL exception: \n"; + print s; + OS.Process.failure) + | Fail s => (print "Fail: "; + print s; + OS.Process.failure) + | ex => (print "Exception!\n"; + List.app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex); OS.Process.failure) end \ No newline at end of file diff --git a/static/sources.cm b/static/sources.cm index 6ddad86..132faac 100644 --- a/static/sources.cm +++ b/static/sources.cm @@ -1,6 +1,8 @@ Group is $/basis.cm + $/smlnj-lib.cm /usr/local/share/smlsql/libpq/sources.cm + /usr/local/share/mlt/src/lib/sources.cm gen.sig gen.sml -- 2.20.1