Ver código fonte

Google Location History import takedown data

Innocenty Enikeew 11 anos atrás
pai
commit
5557a6c52d
1 arquivos alterados com 46 adições e 4 exclusões
  1. 46 4
      process-locations.lisp

+ 46 - 4
process-locations.lisp

@@ -1,3 +1,7 @@
+(defun ts->ms (ts)
+  (+ (* 1000 (local-time:timestamp-to-unix ts))
+     (floor (local-time:nsec-of ts) 1000000)))
+
 (defun doc->point (doc)
   (geo:point-deg
    (/ (get-element "latitudeE7" doc) 1d7)
@@ -8,12 +12,37 @@
    (floor (get-element "timestampMs" doc) 1000)))
 
 (defun day-kv (date)
-  (let* ((ts (local-time:parse-timestring date))
-         (nd (local-time:timestamp+ ts 1 :day)))
+  (ts->kv (local-time:parse-timestring date))
+
+(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
+               (drakma:http-request
+                (format nil
+                        "http://open.mapquestapi.com/nominatim/v1/reverse.php?format=json&lat=~A&lon=~A"
+                        lat lon)
+                :want-stream t)))
+         (address (gethash "address" data)))
+    (values (gethash "display_name" data)
+            address)))
+
+(defun make-place-doc (ts point)
+  (let ((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 :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 extract-places (docs)
   (loop
      for doc in docs
@@ -34,5 +63,18 @@
                   400))
      collect (cons (doc->ts last-place) (doc->point last-place))
      and do (setf need-add nil)
-     when (not last-place) do (setf last-place doc)
-       ))
+     when (not last-place) do (setf last-place doc)))
+
+(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 (db.sort "locations" (ts->kv 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))))
+       until (local-time:timestamp> ts now)
+       finally (return ts))))