19 | _
=> raise C
.Sql
"Bad status"
28 fun statusFromSql v
= statusFromInt (C
.intFromSql v
)
29 fun statusToSql s
= C
.intToSql (statusToInt s
)
31 type app
= { id
: int, name
: string, rname
: string, gname
: string option
, email
: string,
32 forward
: bool, uses
: string, other
: string,
33 passwd
: string, status
: status
, applied
: C
.timestamp
, ipaddr
: string option
,
34 confirmed
: C
.timestamp option
, decided
: C
.timestamp option
,
37 fun mkAppRow
[id
, name
, rname
, gname
, email
, forward
, uses
, other
, passwd
, status
,
38 applied
, ipaddr
, confirmed
, decided
, msg
] =
39 { id
= C
.intFromSql id
, name
= C
.stringFromSql name
, rname
= C
.stringFromSql rname
,
40 gname
= (if C
.isNull gname
then NONE
else SOME (C
.stringFromSql gname
)),
41 email
= C
.stringFromSql email
, forward
= C
.boolFromSql forward
,
42 uses
= C
.stringFromSql uses
, other
= C
.stringFromSql other
, passwd
= C
.stringFromSql passwd
,
43 status
= statusFromSql status
, applied
= C
.timestampFromSql applied
,
44 ipaddr
= (if C
.isNull ipaddr
then NONE
else SOME (C
.stringFromSql ipaddr
)),
45 confirmed
= if C
.isNull confirmed
then NONE
else SOME (C
.timestampFromSql confirmed
),
46 decided
= if C
.isNull decided
then NONE
else SOME (C
.timestampFromSql decided
),
47 msg
= C
.stringFromSql msg
}
48 | mkAppRow r
= rowError ("app", r
)
51 case C
.oneOrNoRows (getDb ()) ($`SELECT id
, name
, rname
, gname
, email
, forward
, uses
, other
, passwd
, status
, applied
, ipaddr
, confirmed
, decided
, msg
53 WHERE id
= ^
(C
.intToSql id
)`
) of
54 SOME row
=> mkAppRow row
55 | NONE
=> raise Fail
"Membership application not found"
58 C
.map (getDb ()) mkAppRow ($`SELECT id
, name
, rname
, gname
, email
, forward
, uses
, other
, passwd
, status
, applied
, ipaddr
, confirmed
, decided
, msg
60 WHERE status
= ^
(statusToSql status
)
63 fun mkVoteRow
[id
, name
] = (C
.intFromSql id
, C
.stringFromSql name
)
64 | mkVoteRow row
= rowError ("app.vote", row
)
66 fun votes id
= C
.map (getDb ()) mkVoteRow ($`SELECT usr
, name
67 FROM AppVote JOIN WebUser ON usr
= id
68 WHERE AppVote
.app
= ^
(C
.intToSql id
)
71 fun vote (usr
, app
) = ignore (C
.dml (getDb ()) ($`INSERT INTO
AppVote (app
, usr
)
72 VALUES (^
(C
.intToSql app
), ^
(C
.intToSql usr
))`
))
74 fun unvote (usr
, app
) = ignore (C
.dml (getDb ()) ($`DELETE FROM AppVote WHERE app
= ^
(C
.intToSql app
) AND usr
= ^
(C
.intToSql usr
)`
))
78 val entry
= lookupApp app
79 val _
= C
.dml (getDb ()) ($`UPDATE MemberApp
80 SET status
= 3, msg
= ^
(C
.stringToSql msg
), decided
= CURRENT_TIMESTAMP
81 WHERE id
= ^
(C
.intToSql app
)`
)
83 val mail
= Mail
.mopen ()
85 Mail
.mwrite (mail
, "From: Hcoop Application System <join");
86 Mail
.mwrite (mail
, emailSuffix
);
87 Mail
.mwrite (mail
, ">\nTo: ");
88 Mail
.mwrite (mail
, #email entry
);
89 Mail
.mwrite (mail
, "\nCc: ");
90 Mail
.mwrite (mail
, boardEmail
);
91 Mail
.mwrite (mail
, "\nSubject: Application denied\n\nYour application for membership has been denied. Reason:\n\n");
92 Mail
.mwrite (mail
, msg
);
93 OS
.Process
.isSuccess (Mail
.mclose mail
)
96 fun approve (app
, msg
) =
98 val entry
= lookupApp app
99 val _
= C
.dml (getDb ()) ($`UPDATE MemberApp
100 SET status
= 2, msg
= ^
(C
.stringToSql msg
), decided
= CURRENT_TIMESTAMP
101 WHERE id
= ^
(C
.intToSql app
)`
)
103 val mail
= Mail
.mopen ()
105 Mail
.mwrite (mail
, "To: ");
106 Mail
.mwrite (mail
, #email entry
);
107 Mail
.mwrite (mail
, "\n");
108 Mail
.mwrite (mail
, Util
.readFile
"/home/hcoop/portal/welcome.txt");
109 Mail
.mwrite (mail
, msg
);
110 OS
.Process
.isSuccess (Mail
.mclose mail
)
114 ignore (C
.dml (getDb ()) ($`UPDATE MemberApp
116 WHERE id
= ^
(C
.intToSql app
)`
))
119 ignore (C
.dml (getDb ()) ($`UPDATE MemberApp
121 WHERE id
= ^
(C
.intToSql app
)`
))
125 val inf
= TextIO.openIn fname
127 fun readLines lines
=
128 case TextIO.inputLine inf
of
129 NONE
=> String.concat (List.rev lines
)
130 | SOME line
=> readLines (line
:: lines
)
133 before TextIO.closeIn inf
136 fun readTosBody () = readFile
"/home/hcoop/public_html/tos.body.html"
137 fun readTosAgree () = readFile
"/home/hcoop/public_html/tos.agree.html"
138 fun readTosMinorAgree () = readFile
"/home/hcoop/public_html/tos.agree.minor.html"