Poll voting limit by membership length

diff --git a/poll.mlt b/poll.mlt
index 4b7d968..735a201 100644 (file)
--- a/poll.mlt
+++ b/poll.mlt
@@ -27,9 +27,13 @@ elseif $"vote" <> "" then
 <tr> <td>Start:</td> <td><% Web.html (#starts poll) %></td> </tr>
 <tr> <td>End:</td> <td><% Web.html (#ends poll) %></td> </tr>
 <tr> <td>Votes/person:</td> <td><% #votes poll %></td> </tr>
+<tr> <td>Official:</td> <td><% if #official poll then "yes" else "no" end %></td> </tr>
 <tr> <td>Description:</td> <td><% Web.htmlNl (#descr poll) %></td> </tr>
 </table>
 
+<% if #official poll and Poll.membershipLength (Init.getUserId ()) < Poll.votingMembershipRequirement then %>
+   <h3>You haven't been a member long enough to vote in an official poll.</h3>
+<% else %>
 <h3>Choices</h3>
 
 <form action="poll" method="post">
@@ -47,7 +51,8 @@ foreach (you, cho) in choices do %>
 <input type="submit" value="Vote">
 </form>
 
-<% elseif $"vote2" <> "" then
+<% end
+elseif $"vote2" <> "" then
        val id = Web.stoi ($"vote2");
        val poll = Poll.lookupPoll id;
        editingPoll := SOME id;
@@ -56,7 +61,9 @@ foreach (you, cho) in choices do %>
                  [""] => []
                | v => map Web.stoi v;
 
-       if length votes > #votes poll then
+       if #official poll and Poll.membershipLength (Init.getUserId ()) < Poll.votingMembershipRequirement then
+               %><h3>You haven't been a member long enough to vote in an official poll.</h3><%
+       elseif length votes > #votes poll then
                %><h3>You can't vote for that many different choices!</h3><%
        elseif not (Poll.noDupes votes) then
                %><h3>You can't vote multiple times for the same choice!</h3><%
@@ -70,6 +77,7 @@ elseif $"cmd" = "add" then
        val starts = $"starts";
        val ends = $"ends";
        val votes = Web.stoi ($"votes");
+       val official = $"official" = "on";
        if title = "" then
                %><h3>Your poll must have a title.</h3><%
        elseif not pollAdmin and not (Poll.dateGeNow starts) then
@@ -79,7 +87,7 @@ elseif $"cmd" = "add" then
        elseif votes <= 0 then
                %><h3>You must specify a positive number of votes per person.</h3><%
        else
-               val id = Poll.addPoll (Init.getUserId(), title, $"descr", starts, ends, votes);
+               val id = Poll.addPoll (Init.getUserId(), title, $"descr", starts, ends, votes, official);
                editingPoll := SOME id;
                %><h3>Poll added!</h3><%
        end
@@ -98,6 +106,7 @@ elseif $"mod" <> "" then
 <tr> <td>Start date:</td> <td><input name="starts" value="<% Web.html (#starts poll) %>"></td> </tr>
 <tr> <td>End date:</td> <td><input name="ends" value="<% Web.html (#ends poll) %>"></td> </tr>
 <tr> <td>Max votes/person:</td> <td><input name="votes" value="<% #votes poll %>"></td> </tr>
+<tr> <td>Official:</td> <td><input type="checkbox" name="official"<% if #official poll then " checked" end %>></td> </tr>
 <tr> <td>Description:</td> <td><textarea name="descr" wrap="soft" rows="5" cols="80"><% Web.html (#descr poll) %></textarea></td> </tr>
 <tr> <td><input type="submit" name="cmd" value="Save"></td> </tr>
 </table>
@@ -112,6 +121,7 @@ elseif $"mod" <> "" then
        val starts = $"starts";
        val ends = $"ends";
        val votes = Web.stoi ($"votes");
+       val official = $"official" = "on";
        if title = "" then
                %><h3>Your poll must have a title.</h3><%
        elseif not pollAdmin and not (Poll.dateGeNow starts) then
@@ -121,7 +131,7 @@ elseif $"mod" <> "" then
        elseif votes <= 0 then
                %><h3>You must specify a positive number of votes per person.</h3><%
        else
-               Poll.modPoll {poll with title = title, descr = $"descr", starts = starts, ends = ends, votes = votes};
+               Poll.modPoll {poll with title = title, descr = $"descr", starts = starts, ends = ends, votes = votes, official = official};
                editingPoll := SOME (#id poll);
                %><h3>Poll record saved.</h3><%
        end
@@ -224,6 +234,7 @@ elseif $"delChoice" <> "" then
 <tr> <td>Start:</td> <td><% Web.html (#starts poll) %></td> </tr>
 <tr> <td>End:</td> <td><% Web.html (#ends poll) %></td> </tr>
 <tr> <td>Votes/person:</td> <td><% #votes poll %></td> </tr>
+<tr> <td>Official:</td> <td><% if #official poll then "yes" else "no" end %></td> </tr>
 <tr> <td>Description:</td> <td><% Web.htmlNl (#descr poll) %></td> </tr>
 </table>
 
@@ -263,6 +274,7 @@ end %>
 <tr> <td>Start:</td> <td><% Web.html (#starts poll) %></td> </tr>
 <tr> <td>End:</td> <td><% Web.html (#ends poll) %></td> </tr>
 <tr> <td>Votes/person:</td> <td><% #votes poll %></td> </tr>
+<tr> <td>Official:</td> <td><% if #official poll then "yes" else "no" end %></td> </tr>
 <tr> <td>Description:</td> <td><% Web.htmlNl (#descr poll) %></td> </tr>
 </table>
 
@@ -315,7 +327,11 @@ end %>
 <%     | NONE =>
 if showNormal then
 
-val polls = Poll.listCurrentPolls ();
+val mlen = Poll.membershipLength (Init.getUserId ()) %>
+
+<p>You have been an HCoop member for <% mlen %> days, so you <b>are<% if mlen < Poll.votingMembershipRequirement then %> not<% end %></b> eligible to vote in official polls.</p>
+
+<% val polls = Poll.listCurrentPolls ();
 switch polls of
        _::_ => %>
 <h3><a href="poll">Current polls</a></h3>
@@ -338,6 +354,7 @@ end %>
 <tr> <td>Start date:</td> <td><input name="starts"></td> </tr>
 <tr> <td>End date:</td> <td><input name="ends"></td> </tr>
 <tr> <td>Max votes/person:</td> <td><input name="votes"></td> </tr>
+<tr> <td>Official:</td> <td><input type="checkbox" name="official"></td> </tr>
 <tr> <td>Description:</td> <td><textarea name="descr" wrap="soft" rows="5" cols="80"></textarea></td> </tr>
 <tr> <td><input type="submit" value="Create"></td> </tr>
 </table>

diff --git a/poll.sig b/poll.sig
index 8111fe9..3542314 100644 (file)
--- a/poll.sig
+++ b/poll.sig
@@ -1,12 +1,12 @@
 signature POLL = sig
-    type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int}
+    type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool}
 
     val lookupPoll : int -> poll
     val listPolls : unit -> poll list
     val listCurrentPolls : unit -> poll list
     val listPollsLimit : int -> poll list
 
-    val addPoll : int * string * string * string * string * int -> int
+    val addPoll : int * string * string * string * string * int * bool -> int
     val modPoll : poll -> unit
     val deletePoll : int -> unit
 
@@ -41,4 +41,8 @@ signature POLL = sig
     (* These operate on poll IDs. *)
     val countVoters : int -> int
     val listPollVoters : int -> Init.user list
+
+    val votingMembershipRequirement : int
+
+    val membershipLength : int -> int
 end

diff --git a/poll.sml b/poll.sml
index 06d49a8..b1fe992 100644 (file)
--- a/poll.sml
+++ b/poll.sml
@@ -3,47 +3,47 @@ struct
 
 open Util Sql Init
 
-type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int}
+type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool}
 
-fun mkPollRow [id, usr, title, descr, starts, ends, votes] =
+fun mkPollRow [id, usr, title, descr, starts, ends, votes, official] =
     {id = C.intFromSql id, usr = C.intFromSql usr, title = C.stringFromSql title,
      descr = C.stringFromSql descr, starts = C.stringFromSql starts,
-     ends = C.stringFromSql ends, votes = C.intFromSql votes}
+     ends = C.stringFromSql ends, votes = C.intFromSql votes, official = C.boolFromSql official}
   | mkPollRow row = Init.rowError ("poll", row)
 
 fun lookupPoll id =
-    case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes
+    case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes, official
                                     FROM Poll
                                     WHERE id = ^(C.intToSql id)`) of
        NONE => raise Fail "Poll not found"
       | SOME row => mkPollRow row
 
 fun listPolls () =
-    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official
                                  FROM Poll
                                  ORDER BY ends, starts DESC, title`)
 
 fun listCurrentPolls () =
-    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official
                                  FROM Poll
                                  WHERE EXTRACT(EPOCH FROM starts) <= EXTRACT(EPOCH FROM CURRENT_DATE)
                                     AND EXTRACT(EPOCH FROM ends) >= EXTRACT(EPOCH FROM CURRENT_DATE)
                                  ORDER BY ends, starts DESC, title`)
 
 fun listPollsLimit lim =
-    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official
                                  FROM Poll
                                  ORDER BY starts DESC, ends, title
                                  LIMIT ^(C.intToSql lim)`)
 
-fun addPoll (usr, title, descr, starts, ends, votes) =
+fun addPoll (usr, title, descr, starts, ends, votes, official) =
     let
        val db = getDb ()
        val id = nextSeq (db, "PollSeq")
     in
-       C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes)
+       C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes, official)
                    VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql title), ^(C.stringToSql descr),
-                           ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes))`);
+                           ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes), ^(C.boolToSql official))`);
        id
     end
 
@@ -55,7 +55,7 @@ fun modPoll (poll : poll) =
                            usr = ^(C.intToSql (#usr poll)), title = ^(C.stringToSql (#title poll)),
                            descr = ^(C.stringToSql (#descr poll)),
                            starts = ^(C.stringToSql (#starts poll)), ends = ^(C.stringToSql (#ends poll)),
-                           votes = ^(C.intToSql (#votes poll))
+                           votes = ^(C.intToSql (#votes poll)), official = ^(C.boolToSql (#official poll))
                            WHERE id = ^(C.intToSql (#id poll))`))
     end
 
@@ -215,4 +215,13 @@ fun listPollVoters pol =
                                     AND usr = WebUser.id
                                  ORDER BY name`)
 
+val votingMembershipRequirement = 45
+
+fun membershipLength id =
+    case C.oneRow (getDb ()) ($`SELECT EXTRACT(DAY FROM (CURRENT_TIMESTAMP - joined))
+                               FROM WebUser
+                               WHERE id = ^(C.intToSql id)`) of
+       [days] => C.intFromSql days
+      | row => Init.rowError ("membershipLength", row)
+
 end

diff --git a/tables.sql b/tables.sql
index 8ff5251..b0b64da 100644 (file)
--- a/tables.sql
+++ b/tables.sql
@@ -104,6 +104,7 @@ CREATE TABLE Poll(
        starts DATE NOT NULL,
        ends DATE NOT NULL,
        votes INTEGER NOT NULL,
+       official BOOL NOT NULL,
        FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
 
 CREATE SEQUENCE PollSeq START 1;