More location features

process-locations.lisp

@@ -5,31 +5,9 @@
   (multiple-value-bind (unix msec) (floor ms 1000)
     (local-time:unix-to-timestamp unix :nsec (* msec 1000000))))
 
-(defun doc->point (doc)
-  (geo:point-deg
-   (/ (get-element "latitudeE7" doc) 1d7)
-   (/ (get-element "longitudeE7" doc) 1d7)))
-
-(defun doc->ts (doc)
-  (local-time:unix-to-timestamp
-   (floor (get-element "timestampMs" doc) 1000)))
-
-(defun docs->locs (docs)
-  (loop for doc in docs
-     collect (cons (doc->ts doc) (doc->point (doc)))))
-
-(defun day-kv (date)
-  (ts->kv (local-time:parse-timestring date)))
-
 (defun $between (a from to)
   (kv ($>= a from) ($< a to)))
 
-(defun ts->kv (ts)
-  (let ((nd (local-time:timestamp+ ts 1 :day)))
-    ($between "timestampMs"
-              (* 1000 (local-time:timestamp-to-unix ts))
-              (* 1000 (local-time:timestamp-to-unix nd)))))
-
 (defun reverse-geocode (lat lon)
   (let* ((data (yason:parse
                 (flexi-streams:octets-to-string
@@ -41,68 +19,119 @@
     (values (gethash "display_name" data)
             address)))
 
-(defun make-place-doc (ts point)
-  (let ((lat (geo:latitude-deg point))
-        (lon (geo:longitude-deg point)))
+(defun make-place-doc (loc)
+  (let* ((point (cdr loc))
+         (lat (geo:latitude-deg point))
+         (lon (geo:longitude-deg point)))
     (multiple-value-bind (text address) (reverse-geocode lat lon)
       (kv
-       (kv :ts (ts->ms ts))
+       (kv :ts (ts->ms (car loc)))
        (kv :type "place")
        (kv :title text)
        (kv :language (gethash "country_code" address))
        (kv :loc (kv (kv :type "Point") ; GeoJSON Point
                     (kv :coordinates (list lon lat))))))))
 
+(defun save-places (places)
+  (loop for place in places
+     do (db.insert "events" (make-place-doc place))))
+
 (defun extract-places (locs)
   (loop
      for loc in locs
      for point = (cdr loc)
-     with last-place and moved and need-add
-     when last-place do (setf moved
-                              (geo:distance>=
-                               (geo:distance-between
-                                point
-                                (cdr last-place))
-                               (geo:distance-meters 100)))
-     when moved do (setf last-place loc
+     with last-place and last-loc and moved and need-add
+     when last-loc do (setf moved
+                            (geo:distance>=
+                             (geo:distance-between
+                              point
+                              (cdr last-loc))
+                             (geo:distance-meters 100)))
+     when moved do (setf last-loc loc ; Store loc as possible place
                          need-add t)
+     when (and need-add last-place last-loc
+               (geo:distance<
+                (geo:distance-between
+                 (cdr last-place)
+                 (cdr last-loc))
+                (geo:distance-meters 200))) do (setf need-add nil) ; Do not add same place after glitch
      when (and need-add
                (> (local-time:timestamp-difference
                    (car loc)
-                   (car last-place))
+                   (car last-loc))
                   400)) ; When stayed in 100m for 6.6mins
-     collect last-place
-     and do (setf need-add nil)
-     when (not last-place) do (setf last-place loc)))
+     collect last-loc
+     and do (setf need-add nil) (setf last-place last-loc)
+     when (not last-loc) do (setf last-loc loc)))
+
+(defun doc->point (doc)
+  (let ((coord (get-element "coordinates"
+                            (get-element "loc" doc))))
+    (geo:point-deg (second coord) (first coord))))
+
+(defun doc->ts (doc)
+  (local-time:unix-to-timestamp
+   (floor (get-element "timestampMs" doc) 1000)))
+
+(defun docs->locs (docs)
+  (loop for doc in docs
+     collect (cons (doc->ts doc) (doc->point doc))))
+
+(defun ts->kv (field ts)
+  (let ((nd (local-time:timestamp+ ts 1 :day)))
+    ($between field
+              (* 1000 (local-time:timestamp-to-unix ts))
+              (* 1000 (local-time:timestamp-to-unix nd)))))
 
 (defun takedown-import (from-date)
   (let ((now (local-time:now)))
     (loop
        for ts = (local-time:parse-timestring from-date) then (local-time:timestamp+ ts 1 :day)
-       for locs = (docs->locs (docs (db.sort "locations" (ts->kv ts) :field "timestampMs" :limit 1440)))
+       for locs = (docs->locs (docs (db.sort "locations" (ts->kv "timestampMs" ts) :field "timestampMs" :limit 1440)))
        for places = (extract-places locs)
        when places do
          (format t "Inserting ~A places for ~A~%" (length places) ts)
-         (loop
-            for place in places
-            do (db.insert "events" (make-place-doc (car place) (cdr place))))
+         (save-places places)
        until (local-time:timestamp> ts now)
        finally (return ts))))
 
-(defvar *google-cookie* "HSID=Aki-sRjrdW5Ikzy3v; SSID=Anhcow9ItEBTeSEg7; APISID=-70vjTcatbI3TD06/AwZG1FFCCDcT4k9fE; SAPISID=dZqsEdkN1kgwG5XK/AHKoDsreJPB4Vw_Ua; NID=67=iUAiGWHq9qJ29H3u0bbOwMDP4jQ8Ef3bL6w9u_eKXRwhTlVyyjsIIWQ11OgszFDjNrdSK_ibUXJot6keGMAqDetXyRTnTyQlR5E0a0DoTbOrul4bX7WEvBr-A24va66oFrMCQYwjSVgR4BK2Q5A1tVcw5tX_iFOH3HfwRZFXzUG6IHHI-96X1XPRoK0TH4D9LVBESdlf-XZLJ8yPv2s7b7NVVgFM1rYwsSbyvA-ps0CTC0DrCDL4L6MOixw0PtuWPsCE7F4-LFzAWAb-7yVhLpLJ; SID=DQAAALEBAAAQi6d7KrAJlOV7d9a8PsJSV0PmImGKfIQ-SUbWmiN8oyGMDYdPdM7Og6dF6VE45MMhzJ5Ckwselasme4hxuTOHqYJfPr7oCj8rz_71TIn1WO-GAkG3nYSh_6wvsG4L2ediBbHJB0LYRMfxYMynr5WEjHm1xDiRGyeIKnY3aZTp6h6rFFPg4ansPuPrig9cSBPpA0vLW5mUko9adS_NpWN8BAY9AQK01GyPq_QV1fDp-hTXwXTFNrYupU576r9-47xDzuG9GPecsihi8WBeFMwyvQBGixmlmxT8eFO6oh4p6Ocp_Ed3OVN-HLeZ0zO0oJSWR8rG_mUAmX9sAG80dEtGMvXvYPnza86nsQNgMyK82GQSHW083W3zxoDE3RoTb6sZh49J8TKPBRzMWL7d7CnUxahmUf-Ro06LLAt6rOOpw5JJzBLZr3UzvKzJWV-2WzEyJlNwmD8fkVFL5qyYBsihhdxWYENR3l3TRjQ5vzLB9QyoBgyka56oVreDAgtnQYB7M8CpY1TnBb_jHJbKSL9nAJYpW8xAwfte5PTb7px5K1rGj9JwSvwYhYwbfJIHh1N4ClwkdLlHBiTvVHkW9QDx")
-(defvar *google-manual-header* "EI9X7MP_UN6KaVDOoQ4mMn91XdQ:1400594464924")
+(defvar *google-cookie* "__utma=237271068.1241244678.1400710443.1400710443.1400710443.1; __utmb=237271068.1.10.1400710443; __utmc=237271068; __utmz=237271068.1400710443.1.1.utmcsr=accounts.google.com|utmccn=(referral)|utmcmd=referral|utmcct=/CheckCookie; HSID=AHszUCr82JTQW17_e; SSID=ApnZu-rKMHkdGKhs8; APISID=UuaDeGjPNgssr6MD/ADVZqAW8jHCM6k3hB; SAPISID=G3CQ4IwqoD0VeqwU/AvbYPYWQ4j7TfA-Me; SID=DQAAAOoAAABmxJYlkDzluCCTEiRrYpicGjIpxCcFVOp8teXB5_LK__YNh1ic_r3o73qT6XTw6dtyGBMU6f6S2xEWUTzQ3WyGTHQDU9iA4-JDWKOEKL30gbJe--j7o6JcVRMHDtusEVnIXGR5lfWZbqJiQ1rcHEyfOdwa_YFHDNGxXZX8CqxOb2XbJg4LsCV2QAkAgPtnttzJy5L39JvVngkoTIf78_CAyVqZb-UPmWAHAMedw3pMjZNuK-vmEpABNiGyDPf6jXn8rSLFMd4VOxhruIsWttSxjS6w2docgpgaL2SDD8HLGeUuxqK7Ww4c_WLhkOiWF1g; NID=67=i0y21lGpfKdTt8LRVZKl-mUp54GsSFLb8FGLVzLFiU1gG4KbQ52HNNPf3-HrXhvmN81AxzGwQPPOIRQ6Z8ciMsG-_Ev7mbeoDtfw8gzLnCiaReU8vVayS2NSFQi6_zg5pStsIlG91eRyYjgy3CxpU-vnO_qYVTs4i03j3XQ")
+(defvar *google-manual-header* "GUem3al6owB4SvGgikUOjC6MFOw:1400710441096")
 
-(defun load-history (from to &key (trim nil))
+(defun load-history (from &optional (to (local-time:timestamp+ from 1 :day)) (trim nil))
   (loop for loc in (cadadr (yason:parse
                             (flexi-streams:octets-to-string
                              (drakma:http-request
-                              "https://maps.google.com/locationhistory/b/1/apps/pvjson?t=0"
+                              "https://maps.google.com/locationhistory/b/0/apps/pvjson?t=0"
                               :method :post
+                              :user-agent "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.114 Safari/537.36"
                               :content (format nil "[null,~A,~A,~A]"
                                                (ts->ms from)
                                                (ts->ms to)
                                                (if trim "true" "false"))
                               :additional-headers (list (cons "x-manualheader" *google-manual-header*)
-                                                        (cons "cookie" *google-cookie*))))))
+                                                        (cons "cookie" *google-cookie*)
+                                                        '("referer" . "https://maps.google.com/locationhistory/b/0"))))))
      collect (cons (ms->ts (parse-integer (cadr loc)))
                    (geo:point-deg (caddr loc) (cadddr loc)))))
+
+(defun make-location-doc (loc)
+  (let* ((point (cdr loc))
+         (lat (geo:latitude-deg point))
+         (lon (geo:longitude-deg point)))
+    (kv
+     (kv "timestampMs" (ts->ms (car loc)))
+     (kv "loc" (kv (kv :type "Point") ; GeoJSON Point
+                   (kv :coordinates (list lon lat)))))))
+
+(defun save-locations (locations)
+  (loop for loc in locations
+     do (db.insert "locations" (make-location-doc loc))))
+
+(defun json-import (from &optional (to (local-time:timestamp+ from 1 :day)))
+  (let* ((locs (load-history from to nil))
+         (places (extract-places locs)))
+    (format t "Saving ~A locations for ~A~%" (length locs) from)
+    (save-locations locs)
+    (format t "Saving ~A place events for ~A~%" (length places) from)
+    (save-places places)))