Update of /cvsroot/hcoop/portal
In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv5441
Modified Files:
money.mlt money.sig money.sml
Log Message:
Most of lowering of pledges for delinquents
Index: money.mlt
===================================================================
RCS file: /cvsroot/hcoop/portal/money.mlt,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** money.mlt 22 Feb 2008 00:59:15 -0000 1.22
--- money.mlt 24 Feb 2008 17:11:02 -0000 1.23
***************
*** 460,463 ****
--- 460,480 ----
end
+ elseif $"cmd" = "delinq" then
+ showNormal := false;
+ val dqs = Money.delinquentPledgers () %>
+ <table>
+ <tr> <th>Member</th> <th>Pledge</th> <th>Balance</th> </tr>
+ <% foreach dq in dqs do %>
+ <tr> <td><a href="user?id=<% #id dq %>"><% #name dq %></a></td> <td><%
#shares dq %></td> <td>$<% #balance dq %></td> </tr>
+ <% end %>
+ </table>
+
+ <a href="?lower=<% String.concatWith "," (List.map (fn dq => Int.toString
(#id dq)) dqs) %>">Lower these pledges to 1</a>
+
+ <% elseif $"lower" <> "" then
+ Money.resetPledges (List.map Web.stoi (String.tokens (fn ch => ch = #",")
($"lower")))
+
+ %><h3>Pledges reset.</h3><%
+
end %>
***************
*** 481,484 ****
--- 498,502 ----
<% if (Group.inGroupName "money" and $"lookback" = "") or $"audit" <> "" then
%>
+ <a href="?cmd=delinq">Drop pledges of delinquent members</a><br>
<a href="?lookback=20">Switch to regular member view</a><br>
Index: money.sml
===================================================================
RCS file: /cvsroot/hcoop/portal/money.sml,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** money.sml 22 Nov 2007 19:24:00 -0000 1.12
--- money.sml 24 Feb 2008 17:11:02 -0000 1.13
***************
*** 274,276 ****
--- 274,297 ----
| row => Init.rowError ("Bad costBase result", row)
+ val monthlyCost = 900.0
+ val graceMonths = 1
+
+ fun delinquentPledgers () =
+ let
+ val costBase = costBase monthlyCost
+
+ fun makeRow [id, name, shares, amount] = {id = C.intFromSql id, name =
C.stringFromSql name,
+ shares = C.intFromSql shares,
balance = C.realFromSql amount}
+ | makeRow row = Init.rowError ("Bad delinquentPledgers", row)
+ in
+ C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id,
WebUserPaying.name, shares, amount
+ FROM WebUserPaying JOIN Balance ON
Balance.id = bal
+ WHERE amount < shares * ^(C.realToSql
costBase) * ^(C.intToSql graceMonths)
+ AND shares > 1
+ ORDER BY name`)
+ end
+
+ fun resetPledges ids =
+ raise Fail ($`UPDATE WebUser SET shares = 1 WHERE id IN
(^(String.concatWith ", " (List.map C.intToSql ids)))`)
+
end
Index: money.sig
===================================================================
RCS file: /cvsroot/hcoop/portal/money.sig,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** money.sig 24 Jul 2006 17:21:19 -0000 1.5
--- money.sig 24 Feb 2008 17:11:02 -0000 1.6
***************
*** 34,36 ****
--- 34,39 ----
val costBase : real -> real
+
+ val delinquentPledgers : unit -> { id : int, name : string, shares : int,
balance : real } list
+ val resetPledges : int list -> unit
end
-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/
_______________________________________________
hcoop-cvs mailing list
hcoop-cvs@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/hcoop-cvs
