From aaa50197ad95b7f5e3aca4293ec4f0201e0f30fc Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Mon, 24 Jul 2006 17:21:19 +0000
Subject: [PATCH] Fixed an HTML error

---
 init.sig   |  7 ++++---
 init.sml   | 28 ++++++++++++++++++----------
 issue.mlt  |  2 +-
 money.sig  |  2 ++
 money.sml  |  5 +++++
 tables.sql |  7 ++++---
 users.mlt  |  2 +-
 util.sig   |  1 +
 util.sml   |  1 +
 9 files changed, 37 insertions(+), 18 deletions(-)

diff --git a/init.sig b/init.sig
index 360b94e..2b1a936 100644
--- a/init.sig
+++ b/init.sig
@@ -11,7 +11,7 @@ signature INIT = sig
     val emailSuffix : string
 
     type user = {id : int, name : string, rname : string, bal : int, joined : C.timestamp,
-		 app : int}
+		 app : int, shares : int}
 
     val rowError : string * C.value list -> 'a
 
@@ -30,10 +30,11 @@ signature INIT = sig
 
     val lookupUser : int -> user
     val listUsers : unit -> user list
-    val addUser : string * string * int * int -> int
-    (* Pass name, real name, and balance ID *)
+    val addUser : string * string * int * int * int -> int
+    (* Pass name, real name, balance ID, and share count *)
     val modUser : user -> unit
     val deleteUser : int -> string
+    val byPledge : unit -> user list
 
     val validUsername : string -> bool
     val userNameToId : string -> int option
diff --git a/init.sml b/init.sml
index 2507a45..78dd86f 100644
--- a/init.sml
+++ b/init.sml
@@ -11,7 +11,7 @@ fun conn () = C.conn dbstring
 val close = C.close
 
 type user = {id : int, name : string, rname : string, bal : int, joined : C.timestamp,
-	     app : int}
+	     app : int, shares : int}
 
 val db = ref (NONE : C.conn option)
 val user = ref (NONE : user option)
@@ -26,10 +26,10 @@ fun rowError (tab, vs) = raise Fail ("Bad " ^ tab ^ "row: " ^ makeSet fromSql vs
 
 fun getDb () = valOf (!db)
 
-fun mkUserRow [id, name, rname, bal, joined, app] =
+fun mkUserRow [id, name, rname, bal, joined, app, shares] =
     {id = C.intFromSql id, name = C.stringFromSql name, rname = C.stringFromSql rname,
      bal = C.intFromSql bal, joined = C.timestampFromSql joined,
-     app = C.intFromSql app}
+     app = C.intFromSql app, shares = C.intFromSql shares}
   | mkUserRow row = rowError ("user", row)
 
 fun init () =
@@ -43,7 +43,7 @@ fun init () =
 	case Web.getCgi "REMOTE_USER" of
 	    NONE => raise Fail "Not logged in"
 	  | SOME name =>
-	    (case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined, app
+	    (case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined, app, shares
   				     FROM WebUserActive
 				     WHERE name=^(C.stringToSql name)`) of
 		 NONE => raise Fail "User not found"
@@ -84,12 +84,12 @@ fun getUserId () = #id (getUser ())
 fun getUserName () = #name (getUser ())
 
 fun lookupUser id =
-    mkUserRow (C.oneRow (getDb ()) ($`SELECT id, name, rname, bal, joined, app
+    mkUserRow (C.oneRow (getDb ()) ($`SELECT id, name, rname, bal, joined, app, shares
 				      FROM WebUser
 			     	      WHERE id = ^(C.intToSql id)`))
 
 fun listUsers () =
-    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares
 			          FROM WebUser
 			          ORDER BY name`)
 
@@ -98,13 +98,14 @@ fun nextSeq (db, seq) =
 	[id] => C.intFromSql id
       | _ => raise Fail "Bad next sequence val"
 
-fun addUser (name, rname, bal, app) =
+fun addUser (name, rname, bal, app, shares) =
     let
 	val db = getDb ()
 	val id = nextSeq (db, "WebUserSeq")
     in
-	C.dml db ($`INSERT INTO WebUser (id, name, rname, bal, joined, app)
-		    VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname), ^(C.intToSql bal), CURRENT_TIMESTAMP, ^(C.intToSql app))`);
+	C.dml db ($`INSERT INTO WebUser (id, name, rname, bal, joined, app, shares)
+		    VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(C.stringToSql rname), ^(C.intToSql bal),
+			    CURRENT_TIMESTAMP, ^(C.intToSql app), ^(C.intToSql shares))`);
 	id
     end
 
@@ -114,10 +115,17 @@ fun modUser (user : user) =
     in
 	ignore (C.dml db ($`UPDATE WebUser SET
 			    name = ^(C.stringToSql (#name user)), rname = ^(C.stringToSql (#rname user)),
-			       bal = ^(C.intToSql (#bal user)), app = ^(C.intToSql (#app user))
+			       bal = ^(C.intToSql (#bal user)), app = ^(C.intToSql (#app user)),
+			       shares = ^(C.intToSql (#shares user))
 			    WHERE id = ^(C.intToSql (#id user))`))
     end
 
+fun byPledge () =
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares
+			          FROM WebUser
+				  WHERE shares > 1
+			          ORDER BY shares DESC`)    
+
 fun deleteUser id =
     C.dml (getDb ()) ($`DELETE FROM WebUser WHERE id = ^(C.intToSql id)`)
 
diff --git a/issue.mlt b/issue.mlt
index da570bc..3a6cb1b 100644
--- a/issue.mlt
+++ b/issue.mlt
@@ -78,7 +78,7 @@ end %>
 <% foreach cat in Support.listCategories () do %>
 	<option value="<% #id cat %>"<% if #id cat = catId then %> selected<% end %>><% Web.html (#name cat) %></option>
 <% end %></select></td> </tr>
-<tr> <td>Title>:</td> <td><input name="title" value="<% Web.html (#title issue) %>"></td> </tr>
+<tr> <td>Title:</td> <td><input name="title" value="<% Web.html (#title issue) %>"></td> </tr>
 <tr> <td><input type="checkbox" name="priv"<% if #priv issue then %> checked<% end %>></td> <td>Only make this issue accessible to the admins for this support category.</td> </tr>
 <tr> <td>Status:</td> <td><select name="status">
 	<option value="0"<% if #status issue = Support.NEW then %> selected<% end %>>New</option>
diff --git a/money.sig b/money.sig
index 81414a9..235c3d8 100644
--- a/money.sig
+++ b/money.sig
@@ -31,4 +31,6 @@ sig
     val addHostingCharges : hosting -> unit
 
     val equalizeBalances : unit -> unit
+
+    val costBase : real -> real
 end
diff --git a/money.sml b/money.sml
index be65cb0..d9e14d9 100644
--- a/money.sml
+++ b/money.sml
@@ -254,4 +254,9 @@ fun lookupHostingUsage trn =
 	before TextIO.closeIn usageFile
     end handle _ => NONE
 
+fun costBase amt =
+    case C.oneRow (getDb ()) ($`SELECT ^(C.realToSql amt) / SUM(shares) FROM WebUserPaying`) of
+	[share] => C.realFromSql share
+      | row => Init.rowError ("Bad costBase result", row)
+
 end
diff --git a/tables.sql b/tables.sql
index 7054c74..fc7a8cc 100644
--- a/tables.sql
+++ b/tables.sql
@@ -35,6 +35,7 @@ CREATE TABLE WebUser(
 	bal INTEGER NOT NULL,
 	joined TIMESTAMP NOT NULL,
 	app INTEGER NOT NULL,
+	shares INTEGER NOT NULL,
 	FOREIGN KEY (bal) REFERENCES Balance(id) ON DELETE CASCADE,
 	FOREIGN KEY (app) REFERENCES MemberApp(id) ON DELETE CASCADE);
 
@@ -248,15 +249,15 @@ CREATE TABLE AppVote(
 	FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
 
 CREATE VIEW WebUserPaying
-	AS SELECT id, name, rname, bal, joined, app
+	AS SELECT id, name, rname, bal, joined, app, shares
 		FROM WebUser
 			JOIN (SELECT usr FROM Membership JOIN WebGroup
 				ON grp = WebGroup.id
-					AND WebGroup.name = 'paying')
+					AND WebGroup.name = 'paying') AS bob
 				ON usr = WebUser.id;
 
 CREATE VIEW WebUserActive
-	AS SELECT id, name, rname, bal, joined, app
+	AS SELECT id, name, rname, bal, joined, app, shares
 		FROM WebUser
 			LEFT OUTER JOIN (SELECT usr FROM Membership JOIN WebGroup
 				ON grp = WebGroup.id AND (WebGroup.name IN ('retired', 'phantom'))) AS mem
diff --git a/users.mlt b/users.mlt
index cd7582b..b192d19 100644
--- a/users.mlt
+++ b/users.mlt
@@ -17,7 +17,7 @@ if $"cmd" = "Create" then
 					  "" => Balance.addBalance ($"name")
 					| s => Web.stoi s);
 
-			val id = Init.addUser ($"name", $"rname", bal, ap);
+			val id = Init.addUser ($"name", $"rname", bal, ap, 1);
 			Group.addToGroups (id, map Web.stoi (Web.getMultiParam "grp"));
 
 			if $"amount" <> "" then
diff --git a/util.sig b/util.sig
index c82c869..5a5697b 100644
--- a/util.sig
+++ b/util.sig
@@ -15,6 +15,7 @@ sig
     val makeSet : ('a -> string) -> 'a list -> string
     val neg : real -> real
     val add : real * real -> real
+    val mult : int * real -> real
 
     val validHost : string -> bool
     val validDomain : string -> bool
diff --git a/util.sml b/util.sml
index 7da69eb..a9ed02b 100644
--- a/util.sml
+++ b/util.sml
@@ -29,6 +29,7 @@ fun makeSet f items =
 
 fun neg (r : real) = ~r
 fun add (r1 : real, r2) = r1 + r2
+fun mult (r1, r2) = real r1 * r2
 
 fun isIdent ch = Char.isLower ch orelse Char.isDigit ch orelse ch = #"-"
 
-- 
2.20.1