Update of /cvsroot/hcoop/portal
In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv16051
Modified Files:
balance.sml money.mlt money.sig money.sml pledge.mlt
Log Message:
Finish changes to follow dues policy changes
Index: balance.sml
===================================================================
RCS file: /cvsroot/hcoop/portal/balance.sml,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** balance.sml 1 Mar 2008 19:30:52 -0000 1.12
--- balance.sml 26 Apr 2008 16:21:59 -0000 1.13
***************
*** 106,110 ****
fun isNegative (bal : balance) = #amount bal < 0.0
! fun depositAmount bal =
let
val db = getDb ()
--- 106,111 ----
fun isNegative (bal : balance) = #amount bal < 0.0
! fun depositAmount _ = 5.0 * 3.0
! (*fun depositAmount bal =
let
val db = getDb ()
***************
*** 115,119 ****
in
3.0 * 900.0 / real totalShares
! end
end
--- 116,120 ----
in
3.0 * 900.0 / real totalShares
! end*)
end
Index: pledge.mlt
===================================================================
RCS file: /cvsroot/hcoop/portal/pledge.mlt,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** pledge.mlt 17 May 2007 18:26:30 -0000 1.3
--- pledge.mlt 26 Apr 2008 16:21:59 -0000 1.4
***************
*** 19,23 ****
val user = Init.getUser () %>
! <p>HCoop divides expenses among members based on a "sliding scale"-style
scheme. We charge you only for our concrete expenses, not adding any expenses
beyond what we pay to service providers and vendors. Whenever a concrete
expense needs to be paid for, we divide it among the members based on how much
each of you has pledged on this web page. Your pledge is a whole number 1 or
higher which you can think of as indicating how many times the amount paid by
the lowest-contributing members you are willing to pay. Concretely, every
expense is divided by the sum of all members' pledges, and each member is
charged an amount equal to the result of that division times his pledge number.
This way <i>everyone's</i> monthly costs go down automatically as we gain new
members.</p>
<h2>Set your pledge number</h2>
--- 19,25 ----
val user = Init.getUser () %>
! <p>Base HCoop membership dues are set at $5/mo.. On this page, you can set a
<i>pledge amount</i> above one, so that you pay 5<i>N</i> dollars a month,
where <i>N</i> is your pledge amount, to help offset costs for members with
more stringent budgets. If the members listed below weren't making extra
pledges, we would need to increase the base dues amount of $5 to cover our
costs.</p>
!
! <!--p>HCoop divides expenses among members based on a "sliding scale"-style
scheme. We charge you only for our concrete expenses, not adding any expenses
beyond what we pay to service providers and vendors. Whenever a concrete
expense needs to be paid for, we divide it among the members based on how much
each of you has pledged on this web page. Your pledge is a whole number 1 or
higher which you can think of as indicating how many times the amount paid by
the lowest-contributing members you are willing to pay. Concretely, every
expense is divided by the sum of all members' pledges, and each member is
charged an amount equal to the result of that division times his pledge number.
This way <i>everyone's</i> monthly costs go down automatically as we gain new
members.</p-->
<h2>Set your pledge number</h2>
***************
*** 29,32 ****
--- 31,37 ----
<h2>Calculate your share of an expense</h2>
+
+ <p>This form is mostly of historical interest, since we've switched to a flat
dues scheme.</p>
+
<form method="post">
<input type="hidden" name="cmd" value="calc">
Index: money.sml
===================================================================
RCS file: /cvsroot/hcoop/portal/money.sml,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** money.sml 9 Apr 2008 13:45:02 -0000 1.14
--- money.sml 26 Apr 2008 16:21:59 -0000 1.15
***************
*** 277,284 ****
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}
--- 277,284 ----
val graceMonths = 1
+ val baseDues = 5.0
+
fun delinquentPledgers () =
let
fun makeRow [id, name, shares, amount] = {id = C.intFromSql id, name =
C.stringFromSql name,
shares = C.intFromSql shares,
balance = C.realFromSql amount}
***************
*** 287,291 ****
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`)
--- 287,291 ----
C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id,
WebUserPaying.name, shares, amount
FROM WebUserPaying JOIN Balance ON
Balance.id = bal
! WHERE amount < shares * ^(C.realToSql
baseDues) * ^(C.intToSql graceMonths)
AND shares > 1
ORDER BY name`)
***************
*** 297,301 ****
fun freezeworthyPledgers () =
let
! val costBase = costBase monthlyCost
fun makeRow [id, name, amount] = {id = C.intFromSql id, name =
C.stringFromSql name,
--- 297,301 ----
fun freezeworthyPledgers () =
let
! val baseDues = 5.0
fun makeRow [id, name, amount] = {id = C.intFromSql id, name =
C.stringFromSql name,
***************
*** 305,310 ****
C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id,
WebUserPaying.name, amount
FROM WebUserPaying JOIN Balance ON
Balance.id = bal
! WHERE amount >= ^(C.realToSql costBase) *
^(C.intToSql graceMonths)
! AND amount < ^(C.realToSql costBase) *
^(C.intToSql (graceMonths + 1))
ORDER BY name`)
end
--- 305,310 ----
C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id,
WebUserPaying.name, amount
FROM WebUserPaying JOIN Balance ON
Balance.id = bal
! WHERE amount >= ^(C.realToSql baseDues) *
^(C.intToSql graceMonths)
! AND amount < ^(C.realToSql baseDues) *
^(C.intToSql (graceMonths + 1))
ORDER BY name`)
end
***************
*** 312,316 ****
fun bootworthyPledgers () =
let
! val costBase = costBase monthlyCost
fun makeRow [id, name, amount] = {id = C.intFromSql id, name =
C.stringFromSql name,
--- 312,316 ----
fun bootworthyPledgers () =
let
! val baseDues = 5.0
fun makeRow [id, name, amount] = {id = C.intFromSql id, name =
C.stringFromSql name,
***************
*** 320,326 ****
C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id,
WebUserPaying.name, amount
FROM WebUserPaying JOIN Balance ON
Balance.id = bal
! WHERE amount < ^(C.realToSql costBase) *
^(C.intToSql graceMonths)
ORDER BY name`)
end
end
--- 320,365 ----
C.map (getDb ()) makeRow ($`SELECT WebUserPaying.id,
WebUserPaying.name, amount
FROM WebUserPaying JOIN Balance ON
Balance.id = bal
! WHERE amount < ^(C.realToSql baseDues) *
^(C.intToSql graceMonths)
ORDER BY name`)
end
+ fun billDues {descr, base, date} =
+ let
+ val db = getDb ()
+ val paying =
+ case Group.groupNameToId "paying" of
+ NONE => raise Fail "No 'paying' group"
+ | SOME id => id
+
+ val shares =
+ case C.oneRow db ($`SELECT SUM(shares)
+ FROM WebUser JOIN Membership ON usr =
WebUser.id AND grp = ^(C.intToSql paying)`) of
+ [n] => C.intFromSql n
+ | row => Init.rowError ("Bad addHostingCharges share count
result", row)
+
+ val total = real shares * base
+
+ val give = addTransaction (descr, ~total, date)
+
+ fun doUser [uid, shares] =
+ let
+ val uid = C.intFromSql uid
+ val shares = C.intFromSql shares
+ in
+ addCharge {trn = give, usr = uid, amount = ~(base * real
shares)}
+ end
+ | doUser r = Init.rowError ("Bad billDues/doUser row", r)
+
+ val receive = addTransaction (descr, total, date)
+
+ val hcoop = valOf (Init.userNameToId "hcoop")
+ in
+ C.app db doUser ($`SELECT id, shares
+ FROM WebUser JOIN Membership ON usr = WebUser.id AND
grp = ^(C.intToSql paying)`);
+ applyCharges give;
+
+ addCharge {trn = receive, usr = hcoop, amount = total};
+ applyCharges receive
+ end
+
end
Index: money.sig
===================================================================
RCS file: /cvsroot/hcoop/portal/money.sig,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** money.sig 9 Apr 2008 13:45:02 -0000 1.7
--- money.sig 26 Apr 2008 16:21:59 -0000 1.8
***************
*** 40,42 ****
--- 40,44 ----
val freezeworthyPledgers : unit -> { id : int, name : string, balance :
real } list
val bootworthyPledgers : unit -> { id : int, name : string, balance :
real } list
+
+ val billDues : {descr : string, base : real, date : string} -> unit
end
Index: money.mlt
===================================================================
RCS file: /cvsroot/hcoop/portal/money.mlt,v
retrieving revision 1.28
retrieving revision 1.29
diff -C2 -d -r1.28 -r1.29
*** money.mlt 19 Apr 2008 20:28:04 -0000 1.28
--- money.mlt 26 Apr 2008 16:21:59 -0000 1.29
***************
*** 340,343 ****
--- 340,364 ----
</form>
+ <% elseif $"cmd" = "dues" then
+ Group.requireGroupName "money";
+ showNormal := false %>
+
+ <h3>Monthly dues</h3>
+
+ <form action="money" method="post">
+ <input type="hidden" name="cmd" value="dues2">
+ <table class="blanks">
+ <tr> <td>Description:</td> <td><input name="descr"></td> </tr>
+ <tr> <td>Date:</td> <td><input name="d"></td> </tr>
+ <tr> <td>Amount/pledge:</td> <td><input name="base"></td> </tr>
+ <tr> <td><input type="submit" value="Add"></td> </tr>
+ </table>
+
+ <% elseif $"cmd" = "dues2" then
+ Group.requireGroupName "money";
+ Money.billDues {descr = $"descr", base = Web.stor ($"base"), date =
$"d"};
+
+ %><h3>Dues debits added.</h3>
+
<% elseif $"cmd" = "even" then
Group.requireGroupName "money";
***************
*** 601,606 ****
<br><b><u>New transaction:</u></b><br>
<a href="money?cmd=bill">Bill for the co-op</a><br>
- <a href="money?cmd=hosting">New hosting bill (old style)</a><br>
<a href="money?cmd=pay">Payment from member</a><br>
<a href="money?cmd=evenForm">Generic/even</a><br>
<br>
--- 622,628 ----
<br><b><u>New transaction:</u></b><br>
<a href="money?cmd=bill">Bill for the co-op</a><br>
<a href="money?cmd=pay">Payment from member</a><br>
+ <a href="money?cmd=dues">Monthly dues</a><br>
+ <a href="money?cmd=hosting">New hosting bill (old style)</a><br>
<a href="money?cmd=evenForm">Generic/even</a><br>
<br>
-------------------------------------------------------------------------
This SF.net email is sponsored by the 2008 JavaOne(SM) Conference
Don't miss this year's exciting event. There's still time to save $100.
Use priority code J8TL2D2.
http://ad.doubleclick.net/clk;198757673;13503038;p?http://java.sun.com/javaone
_______________________________________________
hcoop-cvs mailing list
hcoop-cvs@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/hcoop-cvs
