structure NM = BinaryMapFn(IntKey)
-val outputDir = "/var/www/dyn/"
+val outputDir = "/home/hcoop/public_html/dyn/"
fun generate () =
let
val db = C.conn "dbname='hcoop_hcoop'"
+ fun procOutput (outf, cmdline) =
+ let
+ val proc = Unix.execute cmdline
+ val ins = Unix.textInstreamOf proc
+
+ fun loop () =
+ case TextIO.inputLine ins of
+ NONE => ()
+ | SOME s => (TextIO.output (outf, s); loop ())
+ in
+ loop ();
+ ignore (Unix.reap proc)
+ end
+
fun header (outf, title) =
- (TextIO.output (outf, "<html><head>\n<title>");
- TextIO.output (outf, title);
- TextIO.output (outf, "</title></head>\n<body>\n<h2><b>");
- TextIO.output (outf, title);
- TextIO.output (outf, "</b></h2>\n"))
+ procOutput (outf, ("/usr/local/bin/hcoop_header", [title]))
fun footer outf =
- TextIO.output (outf, "\n</body></html>")
+ procOutput (outf, ("/usr/local/bin/hcoop_footer", []))
fun genMemberList () =
let
end
| printOne _ = raise Fail "Bad printOne line"
- val _ = header (outf, "Member list")
+ val _ = header (outf, "HCoop Member List")
val _ = TextIO.output (outf, "<table>\n")
val (total, anon) = C.fold db printOne (0, 0)
- "SELECT name, rname, usr FROM WebUser LEFT OUTER JOIN DirectoryPref ON id = usr ORDER BY name"
+ "SELECT name, rname, usr FROM WebUserPaying LEFT OUTER JOIN DirectoryPref ON id = usr ORDER BY name"
in
TextIO.output (outf, "</table><br><br>\n\nUnlisted members: ");
TextIO.output (outf, Int.toString anon);
let
val outf = TextIO.openOut (String.concat [outputDir, "member/", name, ".html"])
- val _ = header (outf, "Hcoop member: " ^ name)
+ val _ = header (outf, "HCoop member: " ^ name)
val _ = TextIO.output (outf, "<table>\n<tr> <td align=\"right\"><b>Member</b>:</td> <td>")
val _ = TextIO.output (outf, name)
val _ = TextIO.output (outf, "</td> </tr>\n<tr> <td align=\"right\"><b>Name</b>:</td> <td>")
| doOne _ = raise Fail "Bad member row"
in
ignore (OS.Process.system ("/bin/rm " ^ outputDir ^ "member/*.html"));
- C.app db doOne "SELECT id, name, rname, joined, usr FROM WebUser LEFT OUTER JOIN DirectoryPref ON usr = id"
+ C.app db doOne "SELECT id, name, rname, joined, usr FROM WebUserPaying LEFT OUTER JOIN DirectoryPref ON usr = id"
end
fun genLocations () =
let
val outf = TextIO.openOut (outputDir ^ "locs.html")
- val _ = header (outf, "Where members live")
+ val _ = header (outf, "HCoop: Where members live")
fun countResidents () =
let
addToParents (#loc lives, count)
end
in
- C.fold db folder NM.empty "SELECT loc, usr FROM Lives"
+ C.fold db folder NM.empty "SELECT loc, usr FROM Lives JOIN WebUserActive ON id = usr"
end
val res = countResidents ()
val id = C.intFromSql id
val name = C.stringFromSql name
in
- TextIO.output (outf, "<li> ");
- 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, "</li>\n<ul>\n");
- locationTree (SOME id);
- TextIO.output (outf, "</ul>\n")
+ | SOME n =>
+ (TextIO.output (outf, "<li> ");
+ TextIO.output (outf, Web.html name);
+ TextIO.output (outf, " (");
+ TextIO.output (outf, Int.toString n);
+ TextIO.output (outf, ")");
+ TextIO.output (outf, "</li>\n<ul>\n");
+ locationTree (SOME id);
+ TextIO.output (outf, "</ul>\n"))
end
| doOne _ = raise Fail "Bad locationTree row"
in
let
val outf = TextIO.openOut (outputDir ^ "sites.html")
- val _ = header (outf, "Hosted sites")
+ val _ = header (outf, "HCoop: Hosted sites")
fun doLink [url, title, descr, name] = (C.stringFromSql url, C.stringFromSql title, C.stringFromSql descr, C.stringFromSql name)
| doLink _ = raise Fail "Bad link' row"
val links = C.map db doLink (String.concat ["SELECT url, title, descr, name FROM Link",
- " JOIN WebUser ON WebUser.id = usr",
- " JOIN DirectoryPref ON WebUser.id = DirectoryPref.usr",
+ " JOIN WebUserPaying ON WebUserPaying.id = usr",
+ " JOIN DirectoryPref ON WebUserPaying.id = DirectoryPref.usr",
" ORDER BY title"])
fun appLink (url, title, descr, name) =
handle
C.Sql s => (print "SQL exception: \n";
print s;
+ print "\n";
OS.Process.failure)
| Fail s => (print "Fail: ";
print s;
+ print "\n";
OS.Process.failure)
+ | IO.Io {name, function, ...} => (print "IO exception ";
+ print function;
+ print ": ";
+ print name;
+ print "\n";
+ OS.Process.failure)
| ex => (print "Exception!\n";
List.app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex);
OS.Process.failure)
HCoop / hcoop / portal.git / blobdiff