Fixed an HTML error

diff --git a/init.sig b/init.sig
index 360b94e..2b1a936 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 = #"-"