Artifact 70b60eb247567774d9aceabcf95baac10f4c0e4d:


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 63 61 6e 64   .;; models/cand
0060: 69 64 61 74 65 73 2e 73 63 6d 0a 3b 3b 0a 0a 28  idates.scm.;;..(
0070: 64 65 66 69 6e 65 20 28 63 61 6e 64 69 64 61 74  define (candidat
0080: 65 3a 67 65 74 2d 74 6f 70 20 6e 29 0a 20 20 28  e:get-top n).  (
0090: 64 62 69 3a 67 65 74 2d 72 6f 77 73 20 0a 20 20  dbi:get-rows .  
00a0: 20 28 73 3a 64 62 29 20 0a 20 20 20 22 53 45 4c   (s:db) .   "SEL
00b0: 45 43 54 20 44 49 53 54 49 4e 43 54 20 69 64 2c  ECT DISTINCT id,
00c0: 6e 61 6d 65 2c 75 72 6c 2c 70 61 72 74 79 2c 64  name,url,party,d
00d0: 65 73 63 2c 73 75 70 70 6f 72 74 73 5f 61 76 2c  esc,supports_av,
00e0: 64 61 74 65 5f 61 64 64 65 64 2c 73 63 6f 72 65  date_added,score
00f0: 2c 70 73 63 6f 72 65 20 46 52 4f 4d 20 63 61 6e  ,pscore FROM can
0100: 64 69 64 61 74 65 73 20 41 53 20 63 20 4f 52 44  didates AS c ORD
0110: 45 52 20 42 59 20 73 63 6f 72 65 20 44 45 53 43  ER BY score DESC
0120: 20 4c 49 4d 49 54 20 3f 3b 22 20 6e 29 29 0a 0a   LIMIT ?;" n))..
0130: 3b 3b 20 48 45 52 45 20 21 21 21 21 20 67 65 74  ;; HERE !!!! get
0140: 74 69 6e 67 20 76 6f 74 65 20 63 6f 75 6e 74 73  ting vote counts
0150: 2e 2e 2e 20 44 4f 4e 54 27 55 53 45 2d 20 53 45  ... DONT'USE- SE
0160: 45 20 56 4f 54 45 44 20 49 4e 53 54 45 41 44 0a  E VOTED INSTEAD.
0170: 28 64 65 66 69 6e 65 20 28 63 61 6e 64 69 64 61  (define (candida
0180: 74 65 3a 67 65 74 2d 76 6f 74 65 73 20 63 61 6e  te:get-votes can
0190: 64 69 64 61 74 65 73 20 76 6f 74 65 5f 74 79 70  didates vote_typ
01a0: 65 29 0a 20 20 28 6c 65 74 20 28 28 69 64 73 20  e).  (let ((ids 
01b0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 63 29  (map (lambda (c)
01c0: 28 63 61 6e 64 69 64 61 74 65 3a 67 65 74 2d 69  (candidate:get-i
01d0: 64 20 63 29 29 20 63 61 6e 64 69 64 61 74 65 73  d c)) candidates
01e0: 29 29 29 0a 20 20 20 20 28 64 62 69 3a 67 65 74  ))).    (dbi:get
01f0: 2d 72 6f 77 73 20 28 73 3a 64 62 29 0a 09 09 20  -rows (s:db)... 
0200: 20 28 63 6f 6e 63 0a 09 09 20 20 20 22 53 45 4c   (conc...   "SEL
0210: 45 43 54 20 69 64 2c 73 75 6d 28 76 6f 74 65 73  ECT id,sum(votes
0220: 2a 28 31 2b 73 63 6f 72 65 29 29 20 57 48 45 52  *(1+score)) WHER
0230: 45 20 76 6f 74 65 5f 64 61 74 65 3e 22 0a 09 09  E vote_date>"...
0240: 20 20 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 74     (- (current-t
0250: 69 6d 65 29 20 28 2a 20 32 34 20 36 30 20 36 30  ime) (* 24 60 60
0260: 20 37 29 29 20 3b 3b 20 73 65 76 65 6e 20 64 61   7)) ;; seven da
0270: 79 73 0a 09 09 20 20 20 22 20 41 4e 44 20 69 64  ys...   " AND id
0280: 20 49 4e 20 22 0a 09 09 20 20 20 28 61 70 70 6c   IN "...   (appl
0290: 79 20 63 6f 6e 63 20 28 69 6e 74 65 72 73 70 65  y conc (interspe
02a0: 72 73 65 20 69 64 73 20 22 2c 22 29 29 29 29 29  rse ids ",")))))
02b0: 29 0a 09 09 20 20 20 0a 28 64 65 66 69 6e 65 20  )...   .(define 
02c0: 28 63 61 6e 64 69 64 61 74 65 3a 67 65 74 2d 62  (candidate:get-b
02d0: 79 2d 6e 61 6d 65 20 6e 61 6d 65 29 0a 20 20 28  y-name name).  (
02e0: 64 62 69 3a 67 65 74 2d 6f 6e 65 2d 72 6f 77 20  dbi:get-one-row 
02f0: 28 73 3a 64 62 29 20 22 53 45 4c 45 43 54 20 69  (s:db) "SELECT i
0300: 64 2c 6e 61 6d 65 2c 75 72 6c 2c 70 61 72 74 79  d,name,url,party
0310: 2c 64 65 73 63 2c 73 75 70 70 6f 72 74 73 5f 61  ,desc,supports_a
0320: 76 2c 64 61 74 65 5f 61 64 64 65 64 2c 73 63 6f  v,date_added,sco
0330: 72 65 2c 70 73 63 6f 72 65 20 46 52 4f 4d 20 63  re,pscore FROM c
0340: 61 6e 64 69 64 61 74 65 73 20 57 48 45 52 45 20  andidates WHERE 
0350: 6e 61 6d 65 3d 3f 3b 22 20 6e 61 6d 65 29 29 0a  name=?;" name)).
0360: 0a 3b 3b 20 75 70 64 61 74 65 20 61 6e 20 65 78  .;; update an ex
0370: 69 73 74 69 6e 67 20 63 61 6e 64 69 64 61 74 65  isting candidate
0380: 20 6f 72 20 63 72 65 61 74 65 20 69 66 20 6e 65   or create if ne
0390: 77 0a 28 64 65 66 69 6e 65 20 28 63 61 6e 64 69  w.(define (candi
03a0: 64 61 74 65 3a 75 70 64 61 74 65 20 64 61 74 29  date:update dat)
03b0: 0a 20 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20  .  (let* ((name 
03c0: 20 20 28 63 61 6e 64 69 64 61 74 65 3a 67 65 74    (candidate:get
03d0: 2d 6e 61 6d 65 20 64 61 74 29 29 0a 09 20 28 6f  -name dat)).. (o
03e0: 6c 64 64 61 74 20 28 63 61 6e 64 69 64 61 74 65  lddat (candidate
03f0: 3a 67 65 74 2d 62 79 2d 6e 61 6d 65 20 6e 61 6d  :get-by-name nam
0400: 65 29 29 29 0a 20 20 20 20 28 69 66 20 6f 6c 64  e))).    (if old
0410: 64 61 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28  dat..(begin..  (
0420: 64 62 69 3a 65 78 65 63 20 28 73 3a 64 62 29 20  dbi:exec (s:db) 
0430: 0a 09 09 20 20 20 20 22 55 50 44 41 54 45 20 63  ...    "UPDATE c
0440: 61 6e 64 69 64 61 74 65 73 20 53 45 54 20 75 72  andidates SET ur
0450: 6c 3d 3f 2c 70 61 72 74 79 3d 3f 2c 64 65 73 63  l=?,party=?,desc
0460: 3d 3f 2c 73 75 70 70 6f 72 74 73 5f 61 76 3d 3f  =?,supports_av=?
0470: 20 57 48 45 52 45 20 6e 61 6d 65 3d 3f 3b 22 0a   WHERE name=?;".
0480: 09 09 20 20 20 20 28 63 61 6e 64 69 64 61 74 65  ..    (candidate
0490: 3a 67 65 74 2d 75 72 6c 20 20 20 64 61 74 29 0a  :get-url   dat).
04a0: 09 09 20 20 20 20 28 63 61 6e 64 69 64 61 74 65  ..    (candidate
04b0: 3a 67 65 74 2d 70 61 72 74 79 20 64 61 74 29 0a  :get-party dat).
04c0: 09 09 20 20 20 20 28 63 61 6e 64 69 64 61 74 65  ..    (candidate
04d0: 3a 67 65 74 2d 64 65 73 63 20 20 64 61 74 29 0a  :get-desc  dat).
04e0: 09 09 20 20 20 20 28 63 61 6e 64 69 64 61 74 65  ..    (candidate
04f0: 3a 67 65 74 2d 73 75 70 70 6f 72 74 73 2d 61 76  :get-supports-av
0500: 20 64 61 74 29 0a 09 09 20 20 20 20 6e 61 6d 65   dat)...    name
0510: 29 0a 09 20 20 28 63 61 6e 64 69 64 61 74 65 3a  )..  (candidate:
0520: 67 65 74 2d 62 79 2d 6e 61 6d 65 20 6e 61 6d 65  get-by-name name
0530: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64  ))..(begin..  (d
0540: 62 69 3a 65 78 65 63 20 28 73 3a 64 62 29 0a 09  bi:exec (s:db)..
0550: 09 20 20 20 20 22 49 4e 53 45 52 54 20 49 4e 54  .    "INSERT INT
0560: 4f 20 63 61 6e 64 69 64 61 74 65 73 20 28 6e 61  O candidates (na
0570: 6d 65 2c 75 72 6c 2c 70 61 72 74 79 2c 64 65 73  me,url,party,des
0580: 63 2c 73 75 70 70 6f 72 74 73 5f 61 76 29 20 56  c,supports_av) V
0590: 41 4c 55 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 29  ALUES(?,?,?,?,?)
05a0: 3b 22 0a 09 09 20 20 20 20 6e 61 6d 65 0a 09 09  ;"...    name...
05b0: 20 20 20 20 28 63 61 6e 64 69 64 61 74 65 3a 67      (candidate:g
05c0: 65 74 2d 75 72 6c 20 20 20 64 61 74 29 0a 09 09  et-url   dat)...
05d0: 20 20 20 20 28 63 61 6e 64 69 64 61 74 65 3a 67      (candidate:g
05e0: 65 74 2d 70 61 72 74 79 20 64 61 74 29 0a 09 09  et-party dat)...
05f0: 20 20 20 20 28 63 61 6e 64 69 64 61 74 65 3a 67      (candidate:g
0600: 65 74 2d 64 65 73 63 20 20 64 61 74 29 0a 09 09  et-desc  dat)...
0610: 20 20 20 20 28 63 61 6e 64 69 64 61 74 65 3a 67      (candidate:g
0620: 65 74 2d 73 75 70 70 6f 72 74 73 2d 61 76 20 64  et-supports-av d
0630: 61 74 29 29 0a 09 20 20 28 63 61 6e 64 69 64 61  at))..  (candida
0640: 74 65 3a 67 65 74 2d 62 79 2d 6e 61 6d 65 20 6e  te:get-by-name n
0650: 61 6d 65 29 29 29 29 29 0a 0a 0a 28 64 65 66 69  ame)))))...(defi
0660: 6e 65 20 28 63 61 6e 64 69 64 61 74 65 3a 67 65  ne (candidate:ge
0670: 74 2d 69 64 20 20 20 20 20 20 20 20 20 20 20 64  t-id           d
0680: 61 74 29 28 76 65 63 74 6f 72 2d 72 65 66 20 64  at)(vector-ref d
0690: 61 74 20 30 29 29 20 0a 28 64 65 66 69 6e 65 20  at 0)) .(define 
06a0: 28 63 61 6e 64 69 64 61 74 65 3a 67 65 74 2d 6e  (candidate:get-n
06b0: 61 6d 65 20 20 20 20 20 20 20 20 20 64 61 74 29  ame         dat)
06c0: 28 76 65 63 74 6f 72 2d 72 65 66 20 64 61 74 20  (vector-ref dat 
06d0: 31 29 29 20 0a 28 64 65 66 69 6e 65 20 28 63 61  1)) .(define (ca
06e0: 6e 64 69 64 61 74 65 3a 67 65 74 2d 75 72 6c 20  ndidate:get-url 
06f0: 20 20 20 20 20 20 20 20 20 64 61 74 29 28 76 65           dat)(ve
0700: 63 74 6f 72 2d 72 65 66 20 64 61 74 20 32 29 29  ctor-ref dat 2))
0710: 0a 28 64 65 66 69 6e 65 20 28 63 61 6e 64 69 64  .(define (candid
0720: 61 74 65 3a 67 65 74 2d 70 61 72 74 79 20 20 20  ate:get-party   
0730: 20 20 20 20 20 64 61 74 29 28 76 65 63 74 6f 72       dat)(vector
0740: 2d 72 65 66 20 64 61 74 20 33 29 29 0a 28 64 65  -ref dat 3)).(de
0750: 66 69 6e 65 20 28 63 61 6e 64 69 64 61 74 65 3a  fine (candidate:
0760: 67 65 74 2d 64 65 73 63 20 20 20 20 20 20 20 20  get-desc        
0770: 20 64 61 74 29 28 76 65 63 74 6f 72 2d 72 65 66   dat)(vector-ref
0780: 20 64 61 74 20 34 29 29 0a 28 64 65 66 69 6e 65   dat 4)).(define
0790: 20 28 63 61 6e 64 69 64 61 74 65 3a 67 65 74 2d   (candidate:get-
07a0: 73 75 70 70 6f 72 74 73 2d 61 76 20 20 64 61 74  supports-av  dat
07b0: 29 28 76 65 63 74 6f 72 2d 72 65 66 20 64 61 74  )(vector-ref dat
07c0: 20 35 29 29 0a 28 64 65 66 69 6e 65 20 28 63 61   5)).(define (ca
07d0: 6e 64 69 64 61 74 65 3a 67 65 74 2d 64 61 74 65  ndidate:get-date
07e0: 2d 61 64 64 65 64 20 20 20 64 61 74 29 28 76 65  -added   dat)(ve
07f0: 63 74 6f 72 2d 72 65 66 20 64 61 74 20 36 29 29  ctor-ref dat 6))
0800: 0a 28 64 65 66 69 6e 65 20 28 63 61 6e 64 69 64  .(define (candid
0810: 61 74 65 3a 67 65 74 2d 73 63 6f 72 65 20 20 20  ate:get-score   
0820: 20 20 20 20 20 64 61 74 29 28 76 65 63 74 6f 72       dat)(vector
0830: 2d 72 65 66 20 64 61 74 20 37 29 29 0a 28 64 65  -ref dat 7)).(de
0840: 66 69 6e 65 20 28 63 61 6e 64 69 64 61 74 65 3a  fine (candidate:
0850: 67 65 74 2d 70 73 63 6f 72 65 20 20 20 20 20 20  get-pscore      
0860: 20 64 61 74 29 28 76 65 63 74 6f 72 2d 72 65 66   dat)(vector-ref
0870: 20 64 61 74 20 38 29 29 0a 0a 28 64 65 66 69 6e   dat 8))..(defin
0880: 65 20 28 63 61 6e 64 69 64 61 74 65 3a 73 65 74  e (candidate:set
0890: 2d 69 64 21 20 20 20 20 20 20 20 20 20 20 64 61  -id!          da
08a0: 74 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65  t val)(vector-se
08b0: 74 21 20 64 61 74 20 30 20 76 61 6c 29 29 20 0a  t! dat 0 val)) .
08c0: 28 64 65 66 69 6e 65 20 28 63 61 6e 64 69 64 61  (define (candida
08d0: 74 65 3a 73 65 74 2d 6e 61 6d 65 21 20 20 20 20  te:set-name!    
08e0: 20 20 20 20 64 61 74 20 76 61 6c 29 28 76 65 63      dat val)(vec
08f0: 74 6f 72 2d 73 65 74 21 20 64 61 74 20 31 20 76  tor-set! dat 1 v
0900: 61 6c 29 29 20 0a 28 64 65 66 69 6e 65 20 28 63  al)) .(define (c
0910: 61 6e 64 69 64 61 74 65 3a 73 65 74 2d 75 72 6c  andidate:set-url
0920: 21 20 20 20 20 20 20 20 20 20 64 61 74 20 76 61  !         dat va
0930: 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 64  l)(vector-set! d
0940: 61 74 20 32 20 76 61 6c 29 29 0a 28 64 65 66 69  at 2 val)).(defi
0950: 6e 65 20 28 63 61 6e 64 69 64 61 74 65 3a 73 65  ne (candidate:se
0960: 74 2d 70 61 72 74 79 21 20 20 20 20 20 20 20 64  t-party!       d
0970: 61 74 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73  at val)(vector-s
0980: 65 74 21 20 64 61 74 20 33 20 76 61 6c 29 29 0a  et! dat 3 val)).
0990: 28 64 65 66 69 6e 65 20 28 63 61 6e 64 69 64 61  (define (candida
09a0: 74 65 3a 73 65 74 2d 64 65 73 63 21 20 20 20 20  te:set-desc!    
09b0: 20 20 20 20 64 61 74 20 76 61 6c 29 28 76 65 63      dat val)(vec
09c0: 74 6f 72 2d 73 65 74 21 20 64 61 74 20 34 20 76  tor-set! dat 4 v
09d0: 61 6c 29 29 0a 28 64 65 66 69 6e 65 20 28 63 61  al)).(define (ca
09e0: 6e 64 69 64 61 74 65 3a 73 65 74 2d 73 75 70 70  ndidate:set-supp
09f0: 6f 72 74 73 2d 61 76 21 20 64 61 74 20 76 61 6c  orts-av! dat val
0a00: 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 64 61  )(vector-set! da
0a10: 74 20 35 20 76 61 6c 29 29 0a 28 64 65 66 69 6e  t 5 val)).(defin
0a20: 65 20 28 63 61 6e 64 69 64 61 74 65 3a 73 65 74  e (candidate:set
0a30: 2d 64 61 74 65 2d 61 64 64 65 64 21 20 20 64 61  -date-added!  da
0a40: 74 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65  t val)(vector-se
0a50: 74 21 20 64 61 74 20 36 20 76 61 6c 29 29 0a 28  t! dat 6 val)).(
0a60: 64 65 66 69 6e 65 20 28 63 61 6e 64 69 64 61 74  define (candidat
0a70: 65 3a 73 65 74 2d 73 63 6f 72 65 21 20 20 20 20  e:set-score!    
0a80: 20 20 20 64 61 74 20 76 61 6c 29 28 76 65 63 74     dat val)(vect
0a90: 6f 72 2d 73 65 74 21 20 64 61 74 20 37 20 76 61  or-set! dat 7 va
0aa0: 6c 29 29 0a 0a                                   l))..