Artifact
5caf28d651ec51921d6d31facdd46318c03c788a:
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 37 2d 32 30 30 38 2c 20 4d 61 74 74 68 65 77 20 7-2008, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 20 6d 61 74 74 40 6b 69 Welland. matt@ki
0030: 61 74 6f 61 2e 63 6f 6d 20 41 6c 6c 20 72 69 67 atoa.com All rig
0040: 68 74 73 20 72 65 73 65 72 76 65 64 2e 0a 3b 3b hts reserved..;;
0050: 20 0a 3b 3b 20 6d 6f 64 65 6c 73 2f 76 6f 74 69 .;; models/voti
0060: 6e 67 2e 73 63 6d 0a 3b 3b 0a 3b 3b 20 73 74 6f ng.scm.;;.;; sto
0070: 72 65 20 74 68 65 20 76 6f 74 65 73 21 0a 0a 3b re the votes!..;
0080: 3b 20 6c 6f 6f 6b 20 75 70 20 74 68 65 20 65 6e ; look up the en
0090: 74 72 79 20 74 6f 20 77 68 69 63 68 20 74 6f 20 try to which to
00a0: 61 64 64 20 0a 28 64 65 66 69 6e 65 20 28 76 6f add .(define (vo
00b0: 74 69 6e 67 3a 67 65 74 2d 65 6e 74 72 79 2d 69 ting:get-entry-i
00c0: 64 20 63 61 6e 64 69 64 61 74 65 2d 69 64 20 73 d candidate-id s
00d0: 63 6f 72 65 20 74 79 70 65 29 0a 20 20 28 64 62 core type). (db
00e0: 69 3a 67 65 74 2d 6f 6e 65 20 28 73 3a 64 62 29 i:get-one (s:db)
00f0: 20 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d "SELECT id FROM
0100: 20 76 6f 74 65 73 20 57 48 45 52 45 20 63 61 6e votes WHERE can
0110: 64 69 64 61 74 65 5f 69 64 3d 3f 20 41 4e 44 20 didate_id=? AND
0120: 73 63 6f 72 65 3d 3f 20 41 4e 44 20 76 6f 74 65 score=? AND vote
0130: 5f 74 79 70 65 3d 3f 20 41 4e 44 20 76 6f 74 65 _type=? AND vote
0140: 5f 64 61 74 65 3e 3f 3b 22 0a 09 20 20 20 20 20 _date>?;"..
0150: 20 20 63 61 6e 64 69 64 61 74 65 2d 69 64 0a 09 candidate-id..
0160: 20 20 20 20 20 20 20 73 63 6f 72 65 0a 09 20 20 score..
0170: 20 20 20 20 20 74 79 70 65 0a 09 20 20 20 20 20 type..
0180: 20 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 (- (current-se
0190: 63 6f 6e 64 73 29 20 38 36 34 30 30 29 29 29 20 conds) 86400)))
01a0: 3b 3b 20 69 2e 65 2e 20 73 69 6e 63 65 20 32 34 ;; i.e. since 24
01b0: 20 68 72 73 20 61 67 6f 0a 20 20 0a 28 64 65 66 hrs ago. .(def
01c0: 69 6e 65 20 28 76 6f 74 69 6e 67 3a 61 70 70 6c ine (voting:appl
01d0: 79 2d 76 6f 74 65 20 64 61 74 20 63 61 6e 64 69 y-vote dat candi
01e0: 64 61 74 65 2d 69 64 20 76 6f 74 65 2d 74 79 70 date-id vote-typ
01f0: 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 63 6f e). (let* ((sco
0200: 72 65 20 28 70 65 72 73 6f 6e 3a 67 65 74 2d 73 re (person:get-s
0210: 63 6f 72 65 20 64 61 74 29 29 0a 09 20 28 76 6f core dat)).. (vo
0220: 74 65 2d 65 6e 74 72 79 2d 69 64 20 28 76 6f 74 te-entry-id (vot
0230: 69 6e 67 3a 67 65 74 2d 65 6e 74 72 79 2d 69 64 ing:get-entry-id
0240: 20 63 61 6e 64 69 64 61 74 65 2d 69 64 20 73 63 candidate-id sc
0250: 6f 72 65 20 76 6f 74 65 2d 74 79 70 65 29 29 29 ore vote-type)))
0260: 0a 20 20 20 20 28 69 66 20 76 6f 74 65 2d 65 6e . (if vote-en
0270: 74 72 79 2d 69 64 0a 09 28 64 62 69 3a 65 78 65 try-id..(dbi:exe
0280: 63 20 28 73 3a 64 62 29 20 22 55 50 44 41 54 45 c (s:db) "UPDATE
0290: 20 76 6f 74 65 73 20 53 45 54 20 76 6f 74 65 73 votes SET votes
02a0: 3d 76 6f 74 65 73 2b 31 20 57 48 45 52 45 20 69 =votes+1 WHERE i
02b0: 64 3d 3f 3b 22 20 76 6f 74 65 2d 65 6e 74 72 79 d=?;" vote-entry
02c0: 2d 69 64 29 0a 09 28 64 62 69 3a 65 78 65 63 20 -id)..(dbi:exec
02d0: 28 73 3a 64 62 29 20 22 49 4e 53 45 52 54 20 49 (s:db) "INSERT I
02e0: 4e 54 4f 20 76 6f 74 65 73 20 28 63 61 6e 64 69 NTO votes (candi
02f0: 64 61 74 65 5f 69 64 2c 76 6f 74 65 5f 64 61 74 date_id,vote_dat
0300: 65 2c 76 6f 74 65 73 2c 73 63 6f 72 65 2c 76 6f e,votes,score,vo
0310: 74 65 5f 74 79 70 65 29 20 56 41 4c 55 45 53 28 te_type) VALUES(
0320: 3f 2c 3f 2c 3f 2c 3f 2c 3f 29 3b 22 20 0a 09 09 ?,?,?,?,?);" ...
0330: 20 20 63 61 6e 64 69 64 61 74 65 2d 69 64 0a 09 candidate-id..
0340: 09 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f . (current-seco
0350: 6e 64 73 29 0a 09 09 20 20 31 0a 09 09 20 20 73 nds)... 1... s
0360: 63 6f 72 65 0a 09 09 20 20 76 6f 74 65 2d 74 79 core... vote-ty
0370: 70 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 pe))))..(define
0380: 28 76 6f 74 69 6e 67 3a 72 6f 6c 6c 75 70 2d 76 (voting:rollup-v
0390: 6f 74 65 73 29 0a 20 20 28 6c 65 74 20 28 28 61 otes). (let ((a
03a0: 64 61 74 20 28 64 62 69 3a 67 65 74 2d 72 6f 77 dat (dbi:get-row
03b0: 73 20 28 73 3a 64 62 29 20 0a 09 09 09 20 20 20 s (s:db) ....
03c0: 20 22 53 45 4c 45 43 54 20 63 61 6e 64 69 64 61 "SELECT candida
03d0: 74 65 5f 69 64 20 41 53 20 69 64 2c 53 55 4d 28 te_id AS id,SUM(
03e0: 76 6f 74 65 73 2a 28 73 63 6f 72 65 2b 31 29 29 votes*(score+1))
03f0: 20 41 53 20 73 63 6f 72 65 20 46 52 4f 4d 20 76 AS score FROM v
0400: 6f 74 65 73 20 57 48 45 52 45 20 76 6f 74 65 5f otes WHERE vote_
0410: 64 61 74 65 3e 3f 20 41 4e 44 20 76 6f 74 65 5f date>? AND vote_
0420: 74 79 70 65 3d 31 20 47 52 4f 55 50 20 42 59 20 type=1 GROUP BY
0430: 63 61 6e 64 69 64 61 74 65 5f 69 64 3b 22 0a 09 candidate_id;"..
0440: 09 09 20 20 20 20 28 2d 20 28 63 75 72 72 65 6e .. (- (curren
0450: 74 2d 73 65 63 6f 6e 64 73 29 20 28 2a 20 32 34 t-seconds) (* 24
0460: 20 36 30 20 36 30 20 37 29 29 29 29 0a 09 28 70 60 60 7))))..(p
0470: 64 61 74 20 28 64 62 69 3a 67 65 74 2d 72 6f 77 dat (dbi:get-row
0480: 73 20 28 73 3a 64 62 29 20 0a 09 09 09 20 20 20 s (s:db) ....
0490: 20 22 53 45 4c 45 43 54 20 63 61 6e 64 69 64 61 "SELECT candida
04a0: 74 65 5f 69 64 20 41 53 20 69 64 2c 53 55 4d 28 te_id AS id,SUM(
04b0: 76 6f 74 65 73 2a 28 73 63 6f 72 65 2b 31 29 29 votes*(score+1))
04c0: 20 41 53 20 73 63 6f 72 65 20 46 52 4f 4d 20 76 AS score FROM v
04d0: 6f 74 65 73 20 57 48 45 52 45 20 76 6f 74 65 5f otes WHERE vote_
04e0: 64 61 74 65 3e 3f 20 41 4e 44 20 76 6f 74 65 5f date>? AND vote_
04f0: 74 79 70 65 3d 30 20 47 52 4f 55 50 20 42 59 20 type=0 GROUP BY
0500: 63 61 6e 64 69 64 61 74 65 5f 69 64 3b 22 0a 09 candidate_id;"..
0510: 09 09 20 20 20 20 28 2d 20 28 63 75 72 72 65 6e .. (- (curren
0520: 74 2d 73 65 63 6f 6e 64 73 29 20 28 2a 20 32 34 t-seconds) (* 24
0530: 20 36 30 20 36 30 20 37 29 29 29 29 29 0a 20 20 60 60 7))))).
0540: 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 (for-each.
0550: 20 28 6c 61 6d 62 64 61 20 28 72 6f 77 29 0a 20 (lambda (row).
0560: 20 20 20 20 20 20 28 64 62 69 3a 65 78 65 63 20 (dbi:exec
0570: 28 73 3a 64 62 29 20 22 55 50 44 41 54 45 20 63 (s:db) "UPDATE c
0580: 61 6e 64 69 64 61 74 65 73 20 53 45 54 20 73 63 andidates SET sc
0590: 6f 72 65 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f ore=? WHERE id=?
05a0: 3b 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 ;" (vector-ref r
05b0: 6f 77 20 31 29 28 76 65 63 74 6f 72 2d 72 65 66 ow 1)(vector-ref
05c0: 20 72 6f 77 20 30 29 29 29 0a 20 20 20 20 20 61 row 0))). a
05d0: 64 61 74 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 dat). (for-ea
05e0: 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ch. (lambda
05f0: 28 72 6f 77 29 0a 20 20 20 20 20 20 20 28 64 62 (row). (db
0600: 69 3a 65 78 65 63 20 28 73 3a 64 62 29 20 22 55 i:exec (s:db) "U
0610: 50 44 41 54 45 20 63 61 6e 64 69 64 61 74 65 73 PDATE candidates
0620: 20 53 45 54 20 70 73 63 6f 72 65 3d 3f 20 57 48 SET pscore=? WH
0630: 45 52 45 20 69 64 3d 3f 3b 22 20 28 76 65 63 74 ERE id=?;" (vect
0640: 6f 72 2d 72 65 66 20 72 6f 77 20 31 29 28 76 65 or-ref row 1)(ve
0650: 63 74 6f 72 2d 72 65 66 20 72 6f 77 20 30 29 29 ctor-ref row 0))
0660: 29 0a 20 20 20 20 20 70 64 61 74 29 29 29 0a 0a ). pdat)))..
0670: 3b 3b 20 76 6f 74 65 5f 74 79 70 65 3a 20 30 3d ;; vote_type: 0=
0680: 70 6c 75 72 61 6c 69 74 79 2c 20 31 3d 61 70 70 plurality, 1=app
0690: 72 6f 76 61 6c 0a 28 64 65 66 69 6e 65 20 28 76 roval.(define (v
06a0: 6f 74 69 6e 67 3a 68 61 6e 64 6c 65 2d 76 6f 74 oting:handle-vot
06b0: 65 73 20 65 6d 61 69 6c 20 61 70 70 72 6f 76 61 es email approva
06c0: 6c 20 70 6c 75 72 61 6c 69 74 79 29 0a 20 20 28 l plurality). (
06d0: 6c 65 74 2a 20 28 28 70 64 61 74 20 28 6c 65 74 let* ((pdat (let
06e0: 20 28 28 65 20 28 73 3a 73 65 73 73 69 6f 6e 2d ((e (s:session-
06f0: 76 61 72 2d 67 65 74 20 22 65 6d 61 69 6c 22 29 var-get "email")
0700: 29 29 0a 09 09 20 28 69 66 20 65 20 0a 09 09 20 ))... (if e ...
0710: 20 20 20 20 28 70 65 72 73 6f 6e 3a 67 65 74 2d (person:get-
0720: 64 61 74 20 65 29 0a 09 09 20 20 20 20 20 28 70 dat e)... (p
0730: 65 72 73 6f 6e 3a 63 72 65 61 74 65 2d 6f 72 2d erson:create-or-
0740: 67 65 74 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 get (if (or (not
0750: 20 28 73 74 72 69 6e 67 3f 20 65 6d 61 69 6c 29 (string? email)
0760: 29 20 0a 09 09 09 09 09 09 20 20 20 28 73 74 72 ) ....... (str
0770: 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 ing-match (regex
0780: 70 20 22 5e 5c 5c 73 2a 24 22 29 20 65 6d 61 69 p "^\\s*$") emai
0790: 6c 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 l))......
07a0: 22 6e 6f 6e 61 6d 65 22 20 0a 09 09 09 09 09 20 "noname" ......
07b0: 20 20 20 20 20 20 65 6d 61 69 6c 29 29 29 29 29 email)))))
07c0: 29 20 3b 3b 20 69 73 20 74 68 69 73 20 72 65 61 ) ;; is this rea
07d0: 6c 6c 79 20 74 68 65 20 6c 6f 67 69 63 20 49 20 lly the logic I
07e0: 77 61 6e 74 65 64 3f 0a 20 20 20 20 3b 3b 20 28 wanted?. ;; (
07f0: 73 3a 6c 6f 67 20 22 47 6f 74 20 68 65 72 65 20 s:log "Got here
0800: 65 68 21 22 20 22 20 70 64 61 74 3a 20 22 20 70 eh!" " pdat: " p
0810: 64 61 74 29 0a 20 20 20 20 28 69 66 20 28 6e 6f dat). (if (no
0820: 74 20 70 64 61 74 29 0a 09 28 73 3a 73 65 74 21 t pdat)..(s:set!
0830: 20 22 65 72 72 6d 73 67 22 20 22 46 61 69 6c 65 "errmsg" "Faile
0840: 64 20 74 6f 20 61 75 74 6f 20 6c 6f 67 20 69 6e d to auto log in
0850: 2f 72 65 67 69 73 74 65 72 2c 20 65 6d 61 69 6c /register, email
0860: 20 6f 72 20 6e 69 63 6b 20 61 6c 72 65 61 64 79 or nick already
0870: 20 69 6e 20 75 73 65 2e 20 43 6f 6e 73 69 64 65 in use. Conside
0880: 72 20 72 65 73 65 74 69 6e 67 20 79 6f 75 72 20 r reseting your
0890: 70 61 73 73 77 6f 72 64 22 29 0a 09 28 62 65 67 password")..(beg
08a0: 69 6e 0a 09 20 20 28 73 3a 73 65 73 73 69 6f 6e in.. (s:session
08b0: 2d 76 61 72 2d 73 65 74 21 20 22 65 6d 61 69 6c -var-set! "email
08c0: 22 20 28 70 65 72 73 6f 6e 3a 67 65 74 2d 65 6d " (person:get-em
08d0: 61 69 6c 20 70 64 61 74 29 29 0a 09 20 20 28 76 ail pdat)).. (v
08e0: 6f 74 69 6e 67 3a 61 70 70 6c 79 2d 76 6f 74 65 oting:apply-vote
08f0: 20 70 64 61 74 20 70 6c 75 72 61 6c 69 74 79 20 pdat plurality
0900: 30 29 0a 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 0).. (map (lamb
0910: 64 61 20 28 63 61 6e 64 69 64 61 74 65 2d 69 64 da (candidate-id
0920: 29 0a 09 09 20 28 76 6f 74 69 6e 67 3a 61 70 70 )... (voting:app
0930: 6c 79 2d 76 6f 74 65 20 70 64 61 74 20 63 61 6e ly-vote pdat can
0940: 64 69 64 61 74 65 2d 69 64 20 31 29 29 0a 09 20 didate-id 1))..
0950: 20 20 20 20 20 20 61 70 70 72 6f 76 61 6c 29 0a approval).
0960: 09 20 20 28 76 6f 74 69 6e 67 3a 72 6f 6c 6c 75 . (voting:rollu
0970: 70 2d 76 6f 74 65 73 29 29 29 29 29 p-votes)))))