Coverage report: /home/samppa/personal/opiskelu/ohtuprojekti/pulsu/trunk/map.lisp

KindCoveredAll%
expression667 9.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :puls.ui)
2
 
3
 (defpage (mapview :uri "/map") (search)
4
  (puls.controller::authenticate-user)
5
   (let* ((filter (when search (read-from-string search)))
6
          (file (write-map-kml filter)))
7
     (scp-file file)
8
     (htm
9
      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
10
      (:html
11
       :xmlns "http://www.w3.org/1999/xhtml"
12
       :xml\:lang "fi"
13
       :lang "fi"
14
       (:head
15
        (:meta :http-equiv "Content-Type"
16
               :content    "text/html;charset=iso-8859-1")
17
        (:title "Map View")
18
        (:link :href "static/headerstyle.css" 
19
               :rel "stylesheet" 
20
               :type "text/css")
21
        (:link :href "static/searchstyle.css"
22
               :rel "stylesheet"
23
               :type "text/css")
24
        (:link :href "static/indexstyle.css" 
25
               :rel "stylesheet" 
26
               :type "text/css")
27
        (:script :language "JavaScript" 
28
                 :type "text/javascript" 
29
                 :src "static/SpryEffects.js")
30
        (:script :language "JavaScript" 
31
                 :type "text/javascript" 
32
                 :src "static/prototype-1.6.0.3.js")
33
        (:script :language "JavaScript" 
34
                 :type "text/javascript" 
35
                 :src "static/scriptaculous/scriptaculous.js")
36
        (:script :language "JavaScript" 
37
                 :type "text/javascript" 
38
                 :src "static/search.js")
39
        (:script :language "JavaScript" 
40
                 :type "text/javascript" 
41
                 :src "static/scriptaculous/complete.js")
42
        (:script :src "http://maps.google.com/maps?file=api&amp;v=2&amp;key=ABQIAAAAV4r_u649tCYW4VY1ePpxIBT2yXp_ZAY8_ufC3CFXhHIE1NvwkxSP1ikM8vC7CXAVk4_63QLO4yvE3Q" :type "text/javascript"))
43
       (:body :class "layout"
44
              (header)
45
              (searchbar)
46
              (:div :id "main_content"
47
                    (:h2 "Map View")
48
                    (:div :id "map" :style "width:100%; height:35em")
49
                    )
50
              (:script :type "text/javascript"
51
                       "var map = new GMap(document.getElementById(\"map\"));"
52
                       "map.setCenter(new GLatLng(20,0), 2);"
53
                       "map.setMapType(G_NORMAL_MAP);"
54
                       "map.addControl(new GSmallMapControl());"
55
                       (str
56
                        (format nil
57
                                "var kml = new GGeoXml(\"http://cs.helsinki.fi/group/pulsu/~A\");"
58
                                file))
59
                       "map.addControl(new GMapTypeControl());"
60
                       "map.addOverlay(kml);")
61
              )))))
62
 
63
 
64
 (defun %helper (label how-many add filter)
65
   (link/keep-state*
66
    (format nil "~A: ~A events" label how-many)
67
    "/newest"
68
    :search (format nil "~S"
69
                    (cons add filter))))
70
 
71
 (defun country-describe (filter)
72
   (lambda (locs)
73
     (with-html-output-to-string (*http-stream*)
74
       (let ((country (puls.maps::get-country (first locs)))
75
             (total-count (loop :for i :in locs
76
                                :sum (puls.maps::get-count i))))
77
         (htm
78
          "<![CDATA[ "
79
          (:br (%helper country total-count (list :country country) filter))
80
          "]]>")))))
81
 
82
 (defun loc-describe (filter)
83
   (lambda (locs)
84
     (with-html-output-to-string (*http-stream*)
85
       (let ((country (puls.maps::get-country (first locs)))
86
             (loc (puls.maps::get-location (first locs))))
87
         (htm
88
          "<![CDATA[ "
89
          (:br (%helper country "" (list :country country) filter))
90
          (:br (str "---"))
91
          (dolist (lo locs)
92
            (htm 
93
             (:br
94
              (%helper (getf (puls.maps::get-props lo) :disease)
95
                       (puls.maps::get-count lo)
96
                       (list :country country :location loc
97
                             :disease_name (getf (puls.maps::get-props lo) :disease))
98
                       filter))))
99
          "]]>")))))
100
    
101
 (defparameter *counter* (random 2048))
102
 
103
 (let ((mutex (sb-thread:make-mutex :name "kml-mutex")))
104
   (defun write-map-kml (filter)
105
     (with-mutex (mutex)
106
     (let* ((base (format nil "map~A.kml" (incf *counter*)))
107
            (file (merge-pathnames base
108
                                   cl-user::*project-root*))
109
            (kml
110
             (with-output-to-string (*standard-output*)
111
               (puls.controller::make-map-kml
112
                (get-newest-events :skip 0 :n 200
113
                                   :filter filter )
114
                (country-describe filter)
115
                (loc-describe filter)))))
116
       (with-open-file (stream file
117
                               :direction :output
118
                               :if-exists :supersede)
119
         (princ kml stream))
120
       base))))
121
 
122
 (defun scp-file (filename)
123
   (sb-ext:run-program
124
    "/usr/bin/scp"
125
    (list "-B"
126
          filename
127
          "melkki.cs.helsinki.fi:/home/group/pulsu/public_html/")
128
    :output t))