X-Git-Url: https://git.hcoop.net/hcoop/portal.git/blobdiff_plain/ee587f7fc73f657e8c2c02d622f80069291229a5..220735007a2888e918244b1e2aadfbfbcb18cb4c:/group.sml diff --git a/group.sml b/group.sml index 7c24bbc..afab84f 100644 --- a/group.sml +++ b/group.sml @@ -55,7 +55,7 @@ fun userInGroupNum (usr, grp) = in (case C.oneOrNoRows c ($`SELECT COUNT( * ) FROM Membership - WHERE grp = ^(C.intToSql grp) + WHERE (grp IN (0, ^(C.intToSql grp))) AND usr = ^(C.intToSql usr)`) of SOME[x] => not (C.isNull x) andalso C.intFromSql x <> 0 | _ => false) @@ -67,9 +67,20 @@ fun userInGroupName (usr, grp) = in (case C.oneOrNoRows c ($`SELECT COUNT( * ) FROM Membership, WebGroup - WHERE name = ^(C.stringToSql grp) - AND usr = ^(C.intToSql usr) - AND grp = id`) of + WHERE (grp = 0 OR (name = ^(C.stringToSql grp) AND grp = id)) + AND usr = ^(C.intToSql usr)`) of + SOME[x] => not (C.isNull x) andalso C.intFromSql x <> 0 + | _ => false) + end + +fun userReallyInGroupName (usr, grp) = + let + val c = getDb () + in + (case C.oneOrNoRows c ($`SELECT COUNT( * ) + FROM Membership, WebGroup + WHERE (name = ^(C.stringToSql grp) AND grp = id) + AND usr = ^(C.intToSql usr)`) of SOME[x] => not (C.isNull x) andalso C.intFromSql x <> 0 | _ => false) end @@ -84,11 +95,10 @@ fun addToGroup (mem : membership) = val usr = #usr mem val grp = #grp mem in - if userInGroupNum (usr, grp) then - () - else - ignore (C.dml (getDb ()) ($`INSERT INTO Membership (grp, usr) - VALUES (^(C.intToSql grp), ^(C.intToSql usr))`)) + case C.oneOrNoRows (getDb ()) ($`SELECT * FROM Membership WHERE grp = ^(C.intToSql grp) AND usr = ^(C.intToSql usr)`) of + NONE => ignore (C.dml (getDb ()) ($`INSERT INTO Membership (grp, usr) + VALUES (^(C.intToSql grp), ^(C.intToSql usr))`)) + | SOME _ => () end fun addToGroups (usr, grps) = @@ -109,16 +119,18 @@ fun mkMembershipRow [grp, usr] = | mkMembershipRow row = Init.rowError ("membership", row) fun groupMembers grp = - C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined FROM Membership, WebUser - WHERE grp = ^(C.intToSql grp) - AND usr = id - ORDER BY name`) + C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined, app, shares, paypal, checkout + FROM Membership, WebUser + WHERE grp = ^(C.intToSql grp) + AND usr = id + ORDER BY name`) (* Checking memberships of the current user *) fun inGroupNum grp = userInGroupNum (getUserId(), grp) fun inGroupName grp = userInGroupName (getUserId(), grp) +fun reallyInGroupName grp = userReallyInGroupName (getUserId(), grp) fun requireGroupNum grp = if inGroupNum grp then @@ -132,13 +144,19 @@ fun requireGroupName grp = else raise Access ("You aren't a member of group \"" ^ grp ^ "\"") +fun requireAnyGroupName groups = + if List.exists (fn grp => inGroupName grp) groups then + () + else + raise Access ("You aren't a member of any groups \"" ^ String.concatWith ", " groups ^ "\"") + fun validGroupName name = size name <= 10 - andalso CharVector.all Char.isAlpha name + andalso CharVector.all Char.isAlphaNum name fun groupNameToId name = case C.oneOrNoRows (getDb ()) ($`SELECT id FROM WebGroup WHERE name = ^(C.stringToSql name)`) of SOME [id] => SOME (C.intFromSql id) | _ => NONE -end \ No newline at end of file +end